perm filename EZ[E,ALS]1 blob
sn#224492 filedate 1976-07-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00250 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00023 00002 E -- DISPLAY EDITOR FOR STANFORD
C00036 00003 RIGHT HALF FLAGS
C00039 00004 Character table flags
C00043 00005 BITS FOR GETLIN, SETACT, DEVCHR. S 137 CODE. SORRYU FATALU
C00045 00006 GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE
C00048 00007 BEG BEGSYS BEGACT BEGRPT BEGDBG
C00051 00008 BEGRPG
C00053 00009 BEG0 BEG0.1 BEG0A BEG1 BEGSY2 BEGSY3 BEGSY4 BEG1B BEG1A BEG2 BEGBKP FLOSE FNERR BEGSY1
C00057 00010 BEG3 BEG4 DPYOK NDPYOK
C00063 00011 MAIN MAIN1 MAIN2 FNF FNF1 FNF2
C00066 00012 CMDIN CMDLUP CMDEX CMDEDR XCMDX CMDX CMDX2 ILLATT ILLAT1 CMDEXS CMDLU2
C00070 00013 CMDEDX CMDED CMDRD MINUS PLUS NUMS INFIN ALTSET
C00072 00014 CMDERR ERR PPJ1CR POPJ1C POPJ1 CPOPJ ICHTAB ILLRDO ILLDIR ILLBK ILLMES ILLMS2 ERRX ILLBK PRNTCH
C00075 00015 INIT INIT0 INIT1 NOLOWC INI1
C00082 00016 CMDSP
C00086 00017 XCMDS XDISP MCMDS MDISP
C00089 00018 EXTEND EXTEN1 EXTL0 EXTL EXTL1 EXTL2 EXTL3
C00091 00019 EXTLK0 EXTLK EXTAMX EXTAMB EXTNUL EXTNF EXTNF2 EXTAM2 EXTBUF EXTBFE MACABT
C00094 00020 READON ROSET READWR NORDWR CANCEL SNKOFF SNKON DPYALW DPYSKI NORDOW
C00096 00021 DDTGO R DRAW DRAWX LINCNT DDTRET
C00101 00022 GETOUT GETOU1 FINISH FINI1 FINI2 GORPG QUIT CLOSIT GODRD REOPEN CHKDEL
C00105 00023 NEWPAG NEWPG0 NEWPG1 NEWPG2 NEWPG3 NEWPG4 REREAD PGINIT PGERR PGERR1 NEWPG5
C00110 00024 UNWIND WIND WIND1 LT GT LTE GTE TOP BOT JMP JMPJMP UPARR DWNARR SEMICO COLON CHKMOV CHKMV2 MIDDLE FORMF VERTAB VERTB2 JUMPGL
C00119 00025 MARKS XMARK XMPAGE XXADD XXSUB XPADD XPSUB XLALL XXARRL XXPAGE XXLINE
C00131 00026 DELLIN DELPOS
C00133 00027 DELLP DELL2 DELDSP DELPR DELPR1 DELPR2
C00139 00028 DELPM, DELPM1, DELPM2, DELPM3
C00142 00029 DELPAG, DELPG1, ADJPG, ADJPGL
C00146 00030 RCOMP, RCOMP1, RCOMP2, RCOMPX
C00149 00031 DELETE, DELET1, ADDPAG
C00152 00032 APPEND, APPLUZ
C00155 00033 APPEN2, PMTXT, PMPAG
C00157 00034 INSERT INSER0
C00159 00035 INSER1 INSER2 INSER3 INSER4 INSER5 INSER9 INSE10
C00163 00036 INSER8, DIRADD
C00165 00037 INSER6 INSER7 MARK NDIRCK
C00167 00038 CONTQ
C00169 00039 ATTACH, ATTCH1, ARGCHK, ARGCHN
C00171 00040 ATTDO ATTDO0 ATTDO2 ATTDO1 ATTOK ATTCHK
C00173 00041 ATTREP ATTEX ATTRE3 ATTRE4 ATTRE5 ATTRE6 ATTRE7 ATTRE8 ATTRE9
C00177 00042 ATTKIL, ATTKL, ATTSRC, GPAGL, GPAGL0, GPAGL1, GPAGL2, GPAGL3, ATTWRT
C00179 00043 ATTCOP, ATTCP1, ATTCP
C00180 00044 ATTCP0, ATTCPL, ATCMOR, ATTCP2, ATTCP3, GPAGL
C00182 00045 EDIT EDIT1 LINED LINL1 EDDSP EDARG EDARGX ZLINE
C00185 00046 EDFULL, EDTAB, EDNUL, EDCR, AGAIN, EDRP1, EDRPT
C00187 00047 EDGL EDGL1 EDGL2 EDGL2A EDGL2B EDGBSL IMLPTL
C00190 00048 EDGL3 EDGL4 REEDIT REEDT2 EDTMOR EDGDSP EDTAB2 PTOUT PTPNT EDLF ALTCHK ALTFIX
C00195 00049 EDCR2, EDACT, EDACT2, EDITIT, REPLIN, PUTBAK, UNINS, FNEDIT, EDLF2
C00200 00050 EDPUT, EDPLR
C00202 00051 EDPS, EDPL, EDPLUZ
C00204 00052 EDSNK
C00205 00053 CRDSP REGCR REGCR1 REGCR2
C00207 00054 CONTCR, CNTCR2, METACR, REPRST, REPRS2, METAC2
C00210 00055 LECR DUBLCR DUBCR1 DUBCR2 DUBCR3 DUBCR4
C00213 00056 INSONA, INSONE, INSNUL, INSNLP
C00215 00057 LININS, LININ, LININ0, LININ1
C00217 00058 PPSET ABCRLF ABCRL0 CMDCRL IPPSET DPPSET
C00219 00059 OCT3ST NUMSTD NUMSTR OCTSTR OCTASC NUMSIX
C00221 00060 SETWRT SETWR2 SETWRX BTAB SETWR4 CLEARX
C00223 00061 FRD FRD0 FRD1 NOEXT NOPRG NOPPN NOSWIT SWITL FRDMSG FLHACK FRD0A SETDEV FRD2 FRD2A NOPP1 SWLOP FRDX FRDX2 SIXOUT
C00233 00062 GETNAM GETNML GETP GETPL DTYI1 DTYI DTYI2
C00235 00063 DOSWIT DOSWI2 NTYI NTYIL NTYIM EDFIL EDFIL2 SRCFIL DSTFIL
C00238 00064 RSCAN, RSCAN0, RSCAN1, RSCAN2, RSCAN3, RSCAN4, RSCN4B, RSCN4C, RSCN4A, RSCN0A
C00243 00065 RSCAN5, RSCAN6, RSCAN7, RSCAN8, SYSCCK, CRECHK
C00245 00066 RSTYI RSTYI0 RSTYI1 UCASE TYI1 TYI2 TYI3 TYI4 TYI5 TYI6 TYICHK CTYI1 CTYI2 POPUP POPCJ CSTYI1
C00249 00067 TYI, TYIT, TYIU
C00250 00068 TMPRED, TMPRD1, TMPRD2, TMPRDX, RPGRD1, BKPRED
C00256 00069 TMPWRT, BKPWRT, TMPCOR
C00260 00070 FILERR, FILTYP, FILSTR, PPNTYP, FILETB
C00262 00071 SIXTYO, SIXTYL, SIXTY2, SIXTYN, SIXTNL, SIXTNN, PNTYO, PNTYOL
C00263 00072 UUOH, UUODSP, UFCE, UTYPCH, UTYPC2, UTYPDE, UTYPOC
C00264 00073 UTYPR UTYPR1 USORRY UFATAL FATFIX TELLX TELLZ FATFI2 PANIC
C00268 00074 OPENI, OPNOI, IOPEN, SETI, SETRLD, OPNDEV, RELDEV, OPNLUZ
C00272 00075 RLD, RLD1, RLD2, RLDX, RLDLUZ, FIXEOF, ENTLUZ, ENTL2,RLDCHK
C00276 00076 EXTCHK, EXTCH1, EXTCH2, EXTCH3, EXTCH4, EXTTAB
C00278 00077 OPENW, OPENO, SETO, FPAUSE, PAUSE, PAUS2, BYE
C00280 00078 CLOSO CLOSO2 WRBUF WRBF1 WRBF2 WRBF3 WRBF4 ENTR OBUF IBUF IBFE
C00282 00079 INTLUZ, INTDSP, PDLOV, PDLOV1, PDLOV2, PDLOV3, ISAV, TSINT, TSNINT
C00286 00080 FSINI FSINI1 MORCOR INTERR INTX INTPOV
C00289 00081 FSGET, FSLUP0, FSLUP, FSGRAB, FSXIT
C00290 00082 FSNEWT, FSNEWP, FSNEW
C00291 00083 FSUSED, FSTSML, FSNEXT, FSHRET, FSLLUZ
C00293 00084 FSLSCN, FSLSCL, FSLFR, FSLSHF, FSLSLP, FSLMOV, FSLDON
C00295 00085 FSHSCN, FSHSCL, FSHFR, FSHSHF, FSHSLP, FSHSR, FSHMOV
C00297 00086 FSBLT, POPTJ, FSBLT1
C00298 00087 FSBLT2, FSBLT3, FSHBLT, FSHBL2
C00299 00088 PNTREL, SHFTB, STDSH1, STDSHF, RELOC, RELOCL
C00301 00089 FSGIVE, FSGIV1, FSGIV2
C00302 00090 CORCHK, CRUNCH, CMPACT
C00304 00091 ENDSET, ENDFIX
C00305 00092 FSCHK, FCLUP1, FCLUP2, FCFR, FCDON
C00307 00093 FUCHK, MOVIT, MOVTX
C00308 00094 PURINI, PLCHK, PL2CHK, PLCHKL, PLSCN0, PLSCN, PLSCN1, PLSCN2, PLSCN3
C00310 00095 PURCHK, PURCH1, PURCH2, PURCH3, PURC3A
C00313 00096 PURCH4, PURCH5, PURCH6, PURCH7, PURCLC, TYPHW, PURCK, PLCHK1, PLCHK2, PURFLG
C00315 00097 SAVIT
C00316 00098 CHECK, CHECK1, CHECK2
C00317 00099 CHKDIR, CHKDPL
C00319 00100 CHKDR1 CHKD1A CHKDR2 CDDSP CHKDR3 CHKDR4 CHKD4A
C00321 00101 CHKLST, CHKFS, CHKFSL, CHKFS2, CHKPNT, CHKPN2
C00322 00102 CHKPAG, CHKPGP
C00323 00103 CHKPG1, CHKPG2, CPDSP, CHKPGT, CHKPTL
C00325 00104 CHKPG3, CHKPG4, CHKPG5, CHKPG6
C00326 00105 CHKATT, CHKNAT
C00327 00106 CTAB 0-37
C00331 00107 CTAB 40-77
C00333 00108 CTAB 100-137
C00335 00109 CTAB 140-177
C00337 00110 GETDIR
C00339 00111 DIRCL2, DIRCL, DIRCL1, GETDR1
C00342 00112 DIRLIN DIRLUP DIRDON GDIRX DIRLF DIRLF1 DIRLF2 FINDIR XDRDSP XDIRLN XDIRIL XDCRLF XDIRFF DIRLN2
C00354 00113 LOSDIR BADDIR BADDI2 NODIR DIRNUM GDDSP LSKP1 DIRSHF DIREND UGHDIR FLSDIR IGNDIR DELDIR
C00358 00114 COPFIL, COPFL1, COPDO, COPYX, COPDAT, COPLUP
C00361 00115 COPCOR, COPCHK, YESCHK, COPCMD
C00363 00116 FORMAT FMTOK FMTDSP FORMT2 FORMT3 FORMT4 FORMT5 FORMT6
C00366 00117 NEWDIR, NEWDLP, SKPDSP, NEWDFF, OPUT, OSET, TMPDIR
C00367 00118 MAKDIR, MAKDR0, MAKDR1, MAKDOL, MDOL1
C00369 00119 MDIL1, MDIL1A, MDIL2, MDIL2A, MDCSRC, MDCSR1, MD1DSP
C00371 00120 MDIL1B MAKDLF MAKDFF MDFF1 MDFF2 MDFF3 MDFF4 MDCEOL MD2DSP RLDCHK RLDCK1 RLDCK2 RLDCK3 RLDCKX
C00375 00121 MD1CR, MD2CR, MD3CR, MD3CR1, MDIL3, MDCRCK, MDFIX, MDLFCK
C00378 00122 CREATE, CREAT2, CTEXT
C00380 00123 RDSPA1 RDPAGE RDPGOK RDSPAG RDPAG0 RDSPA2 RDSPA4 RDSPA5
C00384 00124 RDPAG2 RDPAG1 RDLINE RDLLP RDLTAB TELLD1 TELLDZ PSEUDO
C00387 00125 RDLCR RDLLF RDLONG RDLCR2 RDLCR1 RDLCR0
C00389 00126 RDLFF RDLDON LINSET RPDSP RDLNUL LINSE2
C00391 00127 RDPGLZ, SOSTST, SOSCHK, SOSCK2, PGMK, PGMK2
C00393 00128 DIRCHK DIRNEW DIRNW2 DIRNW1 TXTSHF
C00395 00129 FNDLIN, FNDPAG, FNDLN1, FNDLN2, FNDLN3
C00397 00130 REMPTR FIXPTR FNDPT1 FNDPT2 LPTRTB DPTRTB ARRL TOPWIN LINES FIRPAG CURPAG PAGES
C00400 00131 DIRGET, DIRGL, DGEND, DRGSET
C00402 00132 NUM5, NUM5A, DIRHED, DIRTXT, DIREMK, DGDSP
C00404 00133 OUTDIR, OUTDOK, OUTDLP, ODDSP, ODDON, ODEXP
C00406 00134 INSDIR, DCLP1, DCLP2, DCNG, INSDL
C00408 00135 IDDSP0, IDDSP, IDTAB, INSD3, INSD4, SCOMS, SCOMS2
C00410 00136 IDNUL, IDDON, IDDONS
C00412 00137 DIRSET, DIRST1, DIRUP, DIRUP1, DIRUP2, DIRUP3
C00413 00138 DIRFIX, DIRFX1, DIRFX2, DIRFX3, DIRFX4, DIRFXN
C00415 00139 DISPLAY DATA STORAGE
C00417 00140 MORE DISPLAY STORAGE
C00418 00141 HEADERS & TRAILERS -- TOPSTR HEDPAG HEDNAM ROFLG WFLAG TOPDSH HEDLIN BOTSTR DOTS
C00421 00142 DPYINI DPYCHK TTYTST MTLINE LOADMT
C00425 00143 DPYI2, NODPY, WIPE, IWIPE
C00428 00144 SETSCR NMVAR1 NMVARR MOVARR SETARR DSTRL TRLARR GOLINE TRAILS TRAIL0
C00438 00145 SETWIN WINCHK WINCH2 GLDOWN GLUP POPWIN DWNWIN REWIN CENWIN SETWN2
C00442 00146 DISP DISP0 DISP1 DISP2 DISP6
C00445 00147 DISP3, DISP4, DISP5, DUMMY, EXCLR, EXSET,EXTST
C00447 00148 DISPAT, DISPAX
C00448 00149 DDISPX DDSPX2 DDDONE WIPIT WIPL WIPL2
C00449 00150 DDCOP, DDLUZ, LINREL, LINRLL, IDISP, IDISP2
C00450 00151 IIIARR, IIIAR2, IIIAR3
C00452 00152 LESET, LEADJ, LECLR
C00454 00153 DBLT, DBLT1, DBLT2, DBLT3, IDISPX, DISPX, PPBAJ1, POPBAJ, POPAJ
C00456 00154 PCOMPD, PCOMPI, PCOMPS, P2CMPD, P2CMPI
C00457 00155 DDISP, DDISP2
C00458 00156 DOARR, DOAR2, OFFARR, ONARR
C00459 00157 DDISPS, DDSPS2, DDSPS3, DDSPSX, DDSPS4
C00461 00158 DSPSAT, DSPSAX
C00462 00159 DBLTS, DBLTS2, DBLTSN, DBLTS3, DBLTS1, DBLTSA, DBLTA, DBLTA2
C00464 00160 TDISP TDISP0 TDISP1 TDISP2 TDISP3 TDISPE
C00466 00161 TDISP4 TDISP5 TYPE TYPEL TDISPM
C00467 00162 WRPAGE, WRPAG1, WRPAG2, WRBOOK
C00471 00163 WRPX0 WRPX WRPX1 WRPX1A WRPX1B WRPX2 WRPXBP
C00473 00164 WRPX3, WRPX4
C00476 00165 WRPOK, WRTIT, WRT0
C00478 00166 WRP1 WRLINE WRLUP WRLP2 WRRDO WRRDO2 WRRDO3 WRRLUZ
C00480 00167 WRDSP, WRTAB, WRCHK, WRDONE, WRDON2
C00482 00168 WRPM, BTAB2
C00484 00169 FLSPAG, FLSPGL, FLSPG2, CLRWRT, CLRWR2, DSHED
C00485 00170 TV, RSYS, RUN, RUN1
C00488 00171 RUNILL, RUNNON, RUNFNF, RUNDEV, RUNFIL
C00489 00172 SEARCH ROUTINES
C00491 00173 SREAD SREAD0 SREAD1 SREAD2 SREAD3 SREAD4 SRSTOR SRSTR2 QREAD QREADX QREADY QRACT QRACT2 QABORT
C00506 00174 SRACT SREAD5 SRALT SRALT2 SRALUZ SREDT ASTER BSLAS BSLXCT BSLXC2 SREAD5 SREAD6
C00516 00175 FINDIT FOUND FNDMOV FNDERR SUBSTP SUBERR FND2 FND2A SETJMP SUBSP3 SUBSP2 FNDER2 FNDER3 FNDER5
C00521 00176 FIND
C00524 00177 DIRSRC DIRSR2 DFERR SRCDF SDFCR
C00527 00178 SSET, SSET2
C00528 00179 SCOMP SFLUSH NOSRCH SFLSH1 SFLSL
C00530 00180 SBARF, SBARF1, SARRGH, SFSGT, SFSGET, SFSPUT, SFSPTL
C00532 00181 SPARSE
C00533 00182 SPARS1, SPARS2, SPDSP, SSCAN, SSCANA, SSCANX
C00535 00183 SSCAN1, SSCN1A, SSCN1B, SSCQT, SSCBIN, SSCINF, SSCNOT, SSCUOP, SSCVB
C00537 00184 SSCLP, SSCDSP
C00538 00185 SGRAPH, SGRPH1, SGRPH2, SGRPHX, SGDO1, SGDO1X, SGDOX2, SGDSP, SGDO1B
C00540 00186 SGNOT
C00541 00187 SBACK, SBACK1, SBACK2, SBACK3, SBACK4
C00543 00188 SBBRCH, SBBR2
C00544 00189 SBCALC, SBCAL0, SBCAL1, SBCAL2, SBCAL3
C00545 00190 SBCAL4, SBCNON, SBCX, SBCOPL, SBCOP2, SBCEND, SBCEN2, SBCFIX, SBCFXL, SBCFXE, POPJ2
C00547 00191 SBCOK, SBCEN1, SBCLUZ, SBCLZ1, SBCNXT, SBCBP, SBCBPL
C00549 00192 SBCCB, SBCCB1, SBCCB2, SBCCB8, SBCCB3, SBCCB4, SBCCB5
C00551 00193 SBCCB6, SBCCB7, BITCNT, BITCN1
C00552 00194 NEWBIT, NEWBT0, NEWBT1, NEWBT2, NEWBT3, NEWBT4, NEWBT5
C00554 00195 NEWBTC, NEWBC1, NEWBC2, NEWBC3, NEWBNC, NEWBN1, NEWBN2, NEWBN3, NEWBCZ, NEWBNZ
C00556 00196 SCCOM, SCCNOT
C00557 00197 SCCBIT
C00558 00198 MAKBIT, MAKBT0, MAKBT1, MAKBTN, MAKBN2, MAKBTB, MAKBB3
C00560 00199 MAKBNB, MAKBBT, MAKBB2, MBDSP, MBIND, MBIND2
C00562 00200 SCGEN
C00563 00201 SCGEN1, SCGEN2, SCGEN3, SCGEN4, SCGEN5, SCGEN6
C00565 00202 SCGTST, SCGT2, SCGT3, SCGDSP, SCGCN, SCGCN2, SCGBTN, SCGBT
C00567 00203 SCGE, SCGE2, SCGEL, SCGBAK, SCGBK1, SCGBK2, SCGBK3, SCGFA, SCGNC, SCGNFA
C00569 00204 SCGHB, SCGHB0, SCGHB5, SCGHB1, SCGHB2, SCGHB3, SCGHB4, SCGHBX, SCGHX2
C00571 00205 SCGCB, SCGCB0, SCGCB1, SCGCB2, SCGCB3, SCGCB4, SCGCB5, SCGHCB
C00573 00206 SBTMAK, SBTMK1, SBTMK2, SBTMK3, SBTMK4, SCGENB, SCGHB, SSVINS, SCXCT, SBKNW, SBKNWA, SBKDSP
C00575 00207 SRCPAG SRCPG1 SPFIN SPFL SPFL2 SPFX NOSRC2 SRCLBL SRCPG3
C00578 00208 GBYTP, GBYTPL, GBTPX, GBPDSP, GBPTAB
C00579 00209 SRCPGF, SPFTAB, SPFCR, SPFLUZ
C00580 00210 SRCPGB, SPFTAB, SBKNL, SBKNUL
C00582 00211 SRCSET, SRCST1, SRCSTL, SRCST2
C00583 00212 SCALL, SRCHX, SRCHLX
C00585 00213 SCNBAK, SCNBKL
C00587 00214 SCONTF SRCFNP SRCFNB SFNB2 SFRETR SRCDPY SRCDP2 SRCFPP SRCDP3 NOSRCP SRCHED, SRCDD
C00592 00215 SRCFF, SFFNUL, SGTACS, SRTACS
C00593 00216 SRCFB, SFBNUL, SBKNB, SBKNB2, SIOERR, SBKNP
C00594 00217 JCTAB PINXLT PARGET NEXTLI
C00602 00218 J1DSP J2DSP J3DSP J4DSP J5DSP J6DSP J7DSP
C00614 00219 PARGET NEXTLI ADJARG JNEW JMORE
C00619 00220 JUFIX JBLANK J2PASS JMSTRT JINIT JPREAD JMREAD
C00626 00221 TJIDSP TJ1DSP TJFILL TJUST
C00633 00222 JSTOP JJSTOP JFILL JUST
C00643 00223 IND INDENT CENTER ALIGN LFARR RTARR
C00648 00224 JGINIT JGB JGIND JGMAR JGET
C00656 00225 TJREAD TJGET
C00663 00226 BREAK JOIN
C00675 00227 SHIFTY
C00677 00228 MACRO FREE STORAGE - MFSCLR,GETMFS,FREMFS
C00679 00229 MACTYI
C00681 00230 ZDATA ZSIX ZBLT ZEDFIL ZLIST EXIST ZSAVE ZFLDIR ZUNPAK
C00695 00231 LAMBDA EPSIL NWFILE HOME QUERY HOMEG LAMBDG EPSIL5 LAMEPS EPSIL2 EPSIL3 EPSIL4 EPSIL1
C00708 00232 ********* BEG OF ESSAY DEFS *********
C00726 00233 SUBSTR SUBST0 SUBST1 SUBST4 SUBST5 QFAST1 QFAST5 SUBSAY SUBOVE QFAST6 QFAST8 QFAST9
C00737 00234 SPOOLC XSPOOL MAIOUT XWRDSP MAISPL XCLOSO XWRPM XWRDON XWRBF3 XWRTAB XWRLUP XWRLIN SPLINI
C00748 00235 BEGIN SPSUB
C00755 00236 TELBUF,CHKUP,CHECKU,CHTEXT,ASCASC,CHOUT3,CHOUT6
C00762 00237 FILEID TELLME FBI
C00780 00238 MAP
C00788 00239 PAREN
C00791 00240 PARSAV PARL PARR PAR PARFND PARB PAREXT PARRCD PARNUL
C00813 00241 BACKGO BEEPCK BEEPST BEEPS1 BEEPME BEEPUU
C00817 00242 MSG CHKMSG MSG0B MSG0A MSG0 MSG1 MSG2 MSG5 MSG6 MSG7 MSGLUZ MSGBK MSGBK0 CHKMS0
C00825 00243 MACDEF MACCAL MACSTP MACESC MACLIN MACTYP MACINT MACLTT MACKLD
C00839 00244 BURP BURPEX UPDATE PROTEC AUTOBU
C00845 00245 MAIL SEND REMIND
C00847 00246 ALIAS SETHED ALIAS2 ALIAS3 ALIAS4 ALIAS5
C00850 00247 SAVE SPLSTR SAVFIL
C00854 00248 LBLSRC LBLSR2 LBLERR LBLOOP
C00856 00249
C00857 00250 PDL,PATCH,PAT,ZVARS,LEGTAB,BUF,TCBUF,RBUF,FNDTBF,FNDBUF,DIR,SYSCMD,TYIPNT
C00859 ENDMK
C⊗;
;E -- DISPLAY EDITOR FOR STANFORD
;Written by Frederick H.G. Wright II
;with modifications by D. Poole, Art Samuel, Stan Kugell, and Martin Frost.
;The Essay program was contracted by John McCarthy and written by Stan Kugell.
;PRINTS /Type 0 to get ETV, 1 to get ESSAY, then <CTRL><META><LF>./
;ESSFLG←←.INSER TTY:
IFNDEF ESSFLG<ESSFLG←←0>
IFE ESSFLG<TITLE ETV -- DISPLAY EDITOR FOR STANFORD↔SUBTTL FREDERICK H.G. WRIGHT II
PRINTS / You are assembling ETV, the Stanford Display Editor
/
COMMENT % Sep.30 E.64(p581) OCT. 9 E.65(P584) Oct.17 E.66(P597)
Nov.9 E.67(P601) Nov.13 E.68(P605) Nov.21 E.69
E.71 Jan. 31 E.72(P647) FEB.8 E.73(P655)
E.74(P655) E.75(P660)
See E.78, E.77, E.72, E.68, E.66 and E.52 for details about earlier changes.
ESC I interrupt routine preserves JOBTPC through UWAIT to kludge around system bug.
NXTLIN fixed to check ALIN!CEN!INDEN flags correctly in left half instead of right.
E.79
Bug fix to substitution to count non-text ¬'s and ≡'s correctly (SREAD1).
⊗F<string>⊗: command finds label on page given by directory (followed by : = or ←).
ESC I can interrupt the within page search for the label.
⊗F<string>⊗+⊗P looks in directory only on pages after current incore page(s).
Fixed 1→→TXTFLG in SPFIN--caused search to "find" on pagemark text that followed.
Mod to ⊗∂αβD command to delete page even if no text.
Filename scanner fixed to avoid calling EXTCHK if file named in TMPCOR isn't there.
Fix to ∂ command not to go beyond pagemark in finding a message.
Fix to αβD to preserve location of marks beyond line(s) deleted (bug by ME).
Directory search commands made to work correctly in multipage mode.
'MIC' added to list of extensions to look for if no file extension given.
Changing to READWRITE mode allowed when leaving READONLY file from altered page.
ε and λ update display before reading filename from tty.
Altmode typed in response to formatting question implies NO to remaining questions.
Plain CR modified to not add line when given at end of page.
Minor bug fix to -<CR> and 0<CR> at end of page.
Fix to spool routines to use FIRPAG instead of CURPAG as spooler alias page number.
Fix to ⊗F⊗: to make it work in attach mode--CMDEXS sets TF1 meaning from SRACT.
CMDEXS also uses TF1 flag to allow ⊗FαD when on empty line.
CRLF suppressed in middle of numerical argument to any command.
UP.
%>;end of comment and ¬ESSFLG
IFN ESSFLG<TITLE ESSAY
PRINTS / You are assembling Essay.
/>
DEFINE ESSAY <IFN ESSFLG>
DEFINE NOESS <IFE ESSFLG>
COMMENT ⊗ TO PUT UP A NEW E WITH AN UPPER SEGMENT, USE THE COMMANDS:
.LOAD %SE[CSP,SYS]%1<
.S 137 ;RENAMES UPPER, WRITE PROTECTS AND SETS ITS PROTECTION CONSTANT
.SSAVE SYS E ;BE SURE TO SSave (to keep the UPPER SEGMENT around)
TO PUT UP A NEW ERAID (E WITH RAID AND SYMBOLS), DO THIS:
.LOAD %V%S%BE[CSP,SYS]
.S 137 ;RENAMES UPPER TO ERAID AND PROTECTS IT
.SSAVE SYS ERAID
DATA STRUCTURE.
A page of text is represented in memory as a theaded list of
items each representing a single line of the text. Each item in this
representation contains four words of header information, the text of
the line in question and one trailer word.
The first header word contains a TXTCOD, which for ordinary text
is a 2 in the left half and the total number of words in the right half.
This word is used by the free storage management routines, and only
rarely by the text manipulation sections of the code. The word count is
duplicated in the trailer word which is used only by the free storage
routines.
The second header word is a pointer word. It contains a
backward pointer in the left half pointing to the location of the
pointer word of the previous item and in the right half a forward
pointer to the location of the pointer word of the next item. The
location of the pointer word for the first item is contained in the word
at PAGE and the backward pointer for the first item points back to
PAGE. The last item on the page points to the word BOTSTR and this word
points back to this last item and forward to itself. When in the ATTACH
mode, the location ATTBUF points to the pointer word of the first
attached line and back to the pointer word of the last attached line.
The third word contains flag bits in the left half identifying
the type of the line and two 9-bit bytes in the right half. Flag bits
which have been identified are:
400000 the line is a page mark.
200000 the line is ARRLIN (CURRENT to which the arrow points).
100000 the line is WINLIN (the first line on the window).
040000 the line is an Essay reference (for the ESSAY version).
The first byte in the right half contains the total count of the
characters as the line is stored on the disk, where a TAB symbol counts
1 and the terminating CR and LF are counted.
The second byte contains the count of the characters as they are
displayed where a TAB is counted as the number of spaces it produces and
the terminating CR and LF are not counted.
The fourth word is the serial number of the line as kept in the
core. This number is changed every time that a change is made to the line
so this number then bears no relationship to the position of the line on
the page.
The text occupies an integral number of words and is padded out
with nulls.
The trailer word contains the count of the total words in the
item, including header and trailer words. This duplicates the
information in the right half of the first header word.
TABs are handled in a pecular way. When a TAB occurs it is stored
as a TAB and this is followed by as many spaces as the TAB in fact
produces in the text and then by a terminating TAB.
Dispatch tables are used to handle commands and for character dispatching.
A list of these follows. DSP is used as the index register for references
to these tables. This reference is often indirect,- example XCT @CTAB(C)
will be directed to a command indexed by DSP.
Page Page
Table Init.ed on Usage Unusual features
DELDSP 27 27 CONTROL D command
EDDSP 45 45 Editing
EDGDSP 47 48 Editing
CMDSP 48 16 Main command loop
CDDSP 99 99 Check directory
CPDSP 102 103 Check page
XDRDSP 112 112 Extending directory Uses B as flag for doing dir line
GDDSP 110 113 Get directory
SKPDSP 117 117 In NEWDIR routine
MD1DSP 118 119 Make directory
MD2DSP 119 120 Make directory
MDCRCK 121 121
MDLFCK 120 121
RPDSP 127 126 Read page Contains JUMPGE T, entries
RPDSP2 127 126 Pseudo FF in Read page
DGDSP 131
ODDSP 133 133
IDDSP 134
WRDSP 165 Write page
SSCDSP 181
GBPDSP 213 213
JDISP 225 217 Justify
JNDISP 225 217
JDISP 225 217
JDISP2 222 222
JADISP 222
XWRDAP 234 234 Spooling
end of comment ⊗
NOLIT
;Register Most common usage
F←0 ;Flag bits
A←1 ;Argument value
B←2 ;CONTROL and META bits as stripped from command character.
C←3 ;Character
D←4 ;Dispatch table entry
E←5 ;Table location.
G←6
H←7
I←10
DSP←11 ;Dispatch table address
J←12
K←13
Q←14
T←15
TT←16
P←17 ;Always reserved as PDL pointer. (except in search routines?)
;The following macro appears in the Free Storage checking routines to report errors.
DEFINE STOPJ
{PUSHJ P,STOPJC
}
IFNDEF PURESW<PURESW←←1> ;DEFAULT TO SHARABLE PURE UPPER SEGMENT
IFNDEF DEBSW<DEBSW←←1>
IFNDEF BOOKMD<BOOKMD←←1>
;BOOKMD NON-ZERO PERMITS /B MODE FOR READING BOOKS. 0 DISABLES /B MODE.
COPNUM←←3 ;LOG OF # K OF CORE FOR TEMP COPY BUFFER
SRSIZ←←40 ;SIZE OF SEARCH STRING BUFFER
LPDL←←69
DPYBSZ←←=660*2
DSKI←←1
DSKO←←2
SWP←←3
DSKSP←←4 ;Used for spooling file
DSKCH←←5 ;Used to write into bug file TELLME.001[E,ALS] , .002 etc.
IFN BOOKMD, {
RPGO←←4 ;CHANNEL USED TO WRITE OUT .BKP FILE IN BKPSW MODE
};END BOOKMD
...←←0
;Type of display (kept in cell called DPY)
$TTY ←← 0 ;Teletype kludge
$DD ←← 1 ;Datadisk video type display
$III ←← 2 ;III Vector type display
IFNDEF MACDWP<MACDWP←←0> ;Disable DWP's macro-implementing code.
;RIGHT HALF FLAGS
REDNLY←←1 ;READ ONLY MODE
COPY←←2 ;NEED TO DO COPY (← OR →)
DIROK←←4 ;HAVE COMPLETE DIR
UPDTXT←←10 ;LINE 1 CHANGED - UPDATE DIR AT WRPAGE
WRITE←←20 ;SOMETHING CHANGED - NEED TO WRITE IT
EOF←←40 ;INPUT EOF DETECTED - DO ANOTHER LOOKUP (LOSING SYSTEM!)
EDDIR←←100 ;EDITING THE DIRECTORY PAGE
ARG←←200 ;ARG WAS TYPED TO COMMAND
DSPSCR←←400 ;REDISPLAY SCREEN
DSPALL←←1000 ;REDISPLAY WHOLE SCREEN
FILLUZ←←2000 ;EDITING NONSTANDARD FORMAT FILE
REL←←4000 ;RELATIVE ARG (+ OR -)
NEG←←10000 ;NEGATIVE ARG
EDITM←←20000 ;DISPATCH IS FROM LINE EDIT
EDBRK←←40000 ;(WITH EDITM) COMMAND TYPED IN MIDDLE OF LINE
XPAGE←←100000 ;WILL EXPAND FILE FOR PAGE
UPDIR←←200000 ;NON-TEXT CHANGE TO DIR
ATTMOD←←400000 ;IN ATTACH MODE
;LEFT HALF FLAGS
ENTRD←←1 ;EDIT FILE HAS BEEN ENTERED
CLRBF←←2 ;CLEAR OBUF AFTER OUTPUT
NOSHUF←←4 ;DON'T SHUFFLE FREE STORAGE
NOCHK←←10 ;DON'T TRY TO CORE DOWN
OFFEND←←20 ;ARROW ON LINE N+1
NULLIN←←40 ;CURRENT LINE IS EMPTY
ARRPG←←100 ;ARROW POG IS SELECTED
TF1←←200 ;TEMP FLAG, used by just and allied commands
PMLIN←←400 ;CURRENT LINE IS PAGE MARK
OKF←←1000 ;SHOULD TYPE "OK"
;New flags added by ALS.
TF2←←2000 ;TEMP FLAG, used by JUST and allied commands
TF3←←4000 ;Temp flag, used by JUST and allied commands
JOINF←←20000 ;JOIN FLAG
DSPTRL←←40000 ;TRAILER LINE NEEDS TO BE RECALCULATED
LINSM←←100000 ;LINE INSERT MODE
; 200000
NGPUSE←←400000 ;Network Graphic User
; ETV character dispatch displacements:
; 0 null NSPEC
; 1 rubout NSPEC
; 2 CR LSPC
; 3 LF LSPC
; 4 TAB LSPC
; 5 FF LSPC
; 6 ALT LSPC
; 7 misc
; 10 ⊗;
; 11 digit NUMF
;Character table flags
NSPEC←←400000 ;STANDARD SPECIAL CHAR (NULL OR RUBOUT) - MUST BE SIGN
FSPC←←200000 ;FILE NAME DELIMITER
LSPC←←100000 ;SPECIAL CHAR IN LINE
NUMF←←40000 ;DIGIT
DSPC←←20000 ;SPECIAL DIR CHAR
LETF←←10000 ;LETTER - WITH LT2F => LOWER CASE
LT2F←←4000 ;ALONE => $%_ (not a delimiter in searches)
SSP1←←2000 ;TYPE 1 SPECIAL SEARCH STRING CHAR
SSP2←←1000 ; " 2 " ...
EDOK←←40 ;RIGHTMOST OF 4 BITS (SHIFT BY CONTROL BITS) FOR LINE EDITOR LEGALITY
;COMMAND DISPATCH FLAGS
NOEDIT←←200000 ;DISPATCH DIRECTLY FROM LINE EDIT WITHOUT REPLACING LINE
DOEDIT←←100000 ;REPLACE LINE BEFORE DISPATCHING FROM LINE EDIT
;IF NEITHER OF THE ABOVE, RE-EDIT LINE AT SAME CURSOR POS (CMD IS NO-OP)
NOATT←←40000 ;ILLEGAL IN ATTACH MODE
NORDO←←20000 ;ILLEGAL IF READ-ONLY
;10000 ;USER MODE BIT MUST BE UNUSED
SACMD←←4000 ;USES SEARCH ARG
SSCMD←←2000 ;SPECIAL ACTION WHEN ENTERED FROM SEARCH
MSGCMD←←1000 ;SPECIAL ACTION WHEN ENTERED FROM MSG COMMAND (PARTIAL SIGN)
LPDESC←←3 ;# EXTRA WDS DIR ENTRY
DPBIT←←400000 ;DIRPT ENTRY
D1BIT←←200000 ;DIRP1 ENTRY
RPMASK←←77 ;MASK FOR RELATIVE PAGE # FIELD
RPBYTE←←<220600,,> ;BYTE PNTR FOR ABOVE
EDCHRL←←=126 ;Assumed safe display char. count for line editor
;140 less 2 for CRLF and less 12 for 6 TAB's
EDWRDL←←=33 ;Max. words in core per line for line editor (140)/5+5
IMCHRL←←=88 ;Max chars in Imlac line editor
TXTFLG←←2 ;Flag word offset in FS copy of text line
TXTCNT←←1 ;Char count, word offset
TXTSER←←2 ;Serial number assigned to text line, word offset
LLDESC←←3 ;Text offset from linking pointers
;IF YOU CHANGE ANY OF THE ABOVE 4 VALUES, FIX THE BLOCKS CALLED DUMMY and DOTS TOO!!!
;(Formerly TXTFLG was 1, others same as now)
;The following bits are set in left half of word at TXTFLG offset from pointer word
;The right half of this word is now used for the serial number
PMARK←←400000 ;THIS LINE IS A PAGE MARK
ARRBIT←←200000 ;LINE IS ARRLIN
WINBIT←←100000 ;LINE IS WINLIN
PTRBIT←←040000 ;LINE IS COMMENT OR REFERENCE POINTER
LOKBIT←←200000 ;LOCKS DOWN FS BLOCK (CAN'T BE SHUFFLED)
MAXLIN←←=42
ATTMAX←←8
;Flags used in left half of D in FRD and related file-specification code
FRDNAM←←40 ;A new name was typed
FRDEXT←←100 ;An extension was typed
FRDPRJ←←200 ;A project name was typed
FRDPRG←←400 ;A programmer name was typed
FRDDEV←←1000 ;A device was specified
FRDTMP←←200000 ;TMPCOR has been read and may have to be overruled
;FRDRUN must be sign bit.
FRDRUN←←400000 ;Used by XRUN command to get filename without switches
;BITS FOR GETLIN, SETACT, DEVCHR. S 137 CODE. SORRYU FATALU
DD←←20000 ;RUNNING ON DATA DISK
III←←400000 ; " " III (BITS FROM GETLIN)
PTY←←4000 ; " " PTY
IMLIN←←2000 ; " " IMLAC
SUPCCR←←2 ;BREAK TABLE BIT TO SUPPRESS CTRL1-CR HACK
EMODE←←10 ;Break table bit to place 400 after last char when activating
ALLACT←←40 ;Break table bit to make all ctrl chars and BS active unless re-editing
DVDSK←←200000 ;DISK BIT FROM DEVCHR
MININT←←23 ;LOWEST INT BIT #
ADRSIZ←←17 ;# BITS NEEDED TO ADDRESS PERMANENT CODE
ZZ←←.
LOC 137
IFN PURESW,<
JRST [ NOESS,< MOVSI 'E ' ;UPPER NAME ONCE SYSTEMIFIED
SKIPE JOBDDT↑
MOVE ['ERAID ']> ;UPPER NAME FOR VERSION WITH RAID
ESSAY,< MOVE ['ESSAY ']>
SETNM2
JRST 4,137
MOVE P,[-LPDL+1,,PDL] ;Temp stack for checksum compute
PUSHJ P,CHKUP ;Check upper segment before setpro
MOVEM T,CHKSUM
MOVNI 1
SETUWP
JRST 4,137
MOVSI 155000
SETPRO
JRST 4,137
CALLI 12]
>
IFG DEBSW-PURESW,<
JRST [ JSP E,PURINI
CALLI 12]
>
ORG ZZ
FOR @! FOO IN(SORRY,FATAL)
{DEFINE FOO(X)
{ FOO!U [ASCIZ ⊗X⊗]}
}
;GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE
DEFINE GETCHR(X)
{ILDB C,INPNT
SKIPGE X,CTAB(C)
XCT @CTAB(C)}
DEFINE GETCH1(X)
{ILDB C,INPNT
TDNE X,CTAB(C)
XCT @CTAB(C)}
DEFINE GETCH2(X,Y)
{ ILDB C,Y
TDNE X,CTAB(C)
XCT @CTAB(C)}
DEFINE FSFIX(X,Y)
{ HRRI Y,(X)
SUB Y,FSEND
LEG MOVEM Y,@FSEND
LEG HRRZM Y,-1(X)
HRRZM X,FSEND}
IFN DEBSW{DEFINE TSTSHF
{ SKIPE SHFMOD
PUSHJ P,MOVIT}}
IFE DEBSW{DEFINE TSTSHF{}}
DEFINE CW(C1,D1,C2,D2,C3,D3){BYTE(8)D1,D2,D3(3)C1,C2,C3,4}
;THESE MACROS MAKE A LINKED LIST AROUND AND THROUGH
;PURE AND UNPURE PARTS FOR CHECKSUMING THE PURE PARTS
;AN ERROR WILL RESULT IF THE SAME MACRO IS CALLED
;TWICE WITHOUT CALLING THE OTHER MACRO.
%SEG←←0
IFE PURESW{
DEFINE PURE{IFN %SEG{!} %SEG←←1 PURBEG←←.}
DEFINE IMPURE{IFE %SEG{!} %SEG←←0
PURBEG,,PURLK2↔PURLK2←←.-1
PURBEG,,PURLNK↔PURLNK←←.-1}
PURLNK←←PURLK2←←0}
;THESE MACROS SET RELOCATION TO THE PROPER SEGMENT FOR PURE OR UNPURE CODE
;AN ERROR MESSAGE WILL RESULT IF THE SAME MACRO IS CALLED TWICE WITHOUT
;CALLING THE OTHER MACRO.
IFN PURESW{
TWOSEG
RELOC 400000
RELOC
DEFINE PURE{IFN %SEG{!} %SEG←←1 RELOC}
DEFINE IMPURE{IFE %SEG{!} %SEG←←0 RELOC}}
;THIS MACRO SHOULD PRECEDE A LINE OF CODE WHICH CAN
;GENERATE A LEGAL ILL MEM REF.
LEGNUM←←0
DEFINE LEG{FOR @! X←LEGNUM,LEGNUM{LEG!X←←.} LEGNUM←←LEGNUM+1
}
DEFINE UUOS{FOR @! X IN(TYPCHR,TYPDEC,TYPOCT,SORRYU,FATALU)}
ZZ←←0
UUOS{ZZ←←ZZ+1
OPDEF X[ZZ⊗33]
}
NUUOS←←ZZ+1
EXTERN JOBREL,JOBFF,JOBAPR,JOBTPC,JOBDDT,JOBREN,JOBOPC,JOBCNI
PURE
;BEG BEGSYS BEGACT BEGRPT BEGDBG
IFN DEBSW,<JRST BEGDBG>
JRST BEGRPT
BEG: JRST BEG0 ;RUN OR ET COMMAND
JRST BEGRPG ;RPG START. AC'S CONTAIN PARAMS
MOVEM 16,EPDL ;SYSTEM AXXCOM START
MOVEM 17,EPDL2 ;17[SIXBIT COMMAND, 16[ASCII DELIM
JSP P,INIT ;INITIALIZE
MOVE T,EPDL2 ;GET COMMAND NAME
MOVEM T,SYSCMD ;STOW IT
MOVE A,[440700,,BUF] ;INITIAL BYTE POINTER
MOVE C,EPDL ;INITIAL CHARACTER IN "SCAN"
; PUSHJ P,TYIT
; JRST BEGACT
INWAIT
HRLOI T,377777 ;SET T INFINITE
PUSHJ P,RSCN4A ;SCAN REMAINER OF COMMAND FOR ARGS
BEGSYS: LDB C,[301400,,SYSCMD] ;GET 2 CHARACTERS OF COMMAND NAME
PUSHJ P,SYSCCK ;DO WE KNOW THEM
JRST BEG1 ;YES. NOW WE READ FILE NAME FROM TTY
JRST BEG0 ;DONT UNDERSTAND COMMAND. RESCAN.
BEGACT: MOVE T,[440700,,[ASCIZ /
/]]
MOVEM T,TYIPNT
JRST BEGSYS
BEGRPT: JSP P,INIT ;INITIALIZE
PUSHJ P,TMPRED ;TRY TO READ TMPCORE FILE
JRST BEG0A
PUSH P,TYIPNT ;SAVE POINTER TO ARGS
MOVEM G,TYIPNT ;POINT TO COMMAND
PUSHJ P,GETNAM ;AND READ IT
MOVEM A,SYSCMD
POP P,TYIPNT ;NOW POINT TO ARGS AGAIN
JRST BEGSYS ;AND LOOK LIKE AXXCOM STARTUP
IFN DEBSW,<
BEGDBG: JSP P,INIT ;HERE FOR DEBUGGING. INITIALIZE
INWAIT ;WAIT FOR SOMETHING TO BE TYPED
HRLOI T,377777 ;SET CHARACTER COUNT TO INFINITE
PUSHJ P,RSCAN0 ;READ COMMAND, AVOID RESCAN
JRST BEG0A ;ACT NORMAL
>
;BEGRPG
;HERE AT RPG STARTUP.
BEGRPG: MOVEM 17,RPGACS+17
MOVEI 17,RPGACS
BLT 17,RPGACS+16 ;SAVE RPG PARAMETERS
JSP P,INIT0 ;INITIALIZE
HRRZ T,RPGLIN
CAILE T,=999
SETZB T,RPGLIN
MOVEM T,SLINE ;STARTING LINE NUMBER
SKIPGE T,RPGPAG
MOVEI T,
MOVEM T,SPAGE ;STARTING PAGE NUMBER
MOVSI T,'DSK'
MOVEM T,EDFIL-1 ;DEFAULT DEVICE
SKIPN T,RPGFIL
EXIT ;NO FILE NAME - NO EDIT.
MOVEM T,EDFIL ;SAVE EDIT FILE NAME
SKIPN T,RPGPPN
MOVE T,PPN
MOVEM T,EDFIL+3 ;EDIT FILE PPN
MOVE T,RPGEXT
HLLZM T,EDFIL+1 ;EDIT FILE EXT
SETZM EDFIL+2
SETZM EDFIL+4
TRNE T,200000 ;INSPECT MODE FLAGS
SETOM RDONLY ;/R READONLY
HRLOI TT,1
ANDCM TT,RDONLY ;Don't set /N flag in /R mode
TRNE T,100000
MOVEM TT,EDFIL+4 ;SET /N NO DIRECTORY
TRNE T,400000
SETOM CREASW ;CREATING
JRST BEG3
IMPURE
RPGACS: BLOCK 11 ;PLACE TO SAVE RPG PARAMETERS
RPGPPN: 0
0
RPGEXT: 0
RPGFIL: 0
RPGLIN: 0
RPGPAG: 0
0
PURE
;BEG0 BEG0.1 BEG0A BEG1 BEGSY2 BEGSY3 BEGSY4 BEG1B BEG1A BEG2 BEGBKP FLOSE FNERR BEGSY1
BEG0: JSP P,INIT ;INITIALIZE
BEG0.1: PUSHJ P,RSCAN ;RESCAN TTY
BEG0A: SKIPN TYIPNT ;WAS THERE ANYTHING THERE?
OUTSTR [ASCIZ /
FILE? /] ;NO. ASK FOR SOME.
BEG1: MOVEI D,EDFIL ;Place to put filename
SKIPE ZATT ;Are we coming from E command or monitor command?
JRST BEGSY2 ;E command, ignore TMPCOR
LDB C,[301400,,SYSCMD] ;GET THE COMMAND NAME
PUSHJ P,CRECHK ;WAS IT CREATE?
JRST [SETOM CREASW ;YES. SET FLAG
JRST BEGSY2]
IFN BOOKMD, {
CAIN C,'RE' ;"READ" COMMAND?
JRST BEGBKP ;YES
};END BOOKMD
JUMPN C,BEGSY1 ;WAS IT SOME SORT OF COMMAND AT ALL?
BEGSY2: PUSHJ P,FRD ;READ FILE NAME (TTY OR RESCANNED DATA)
JRST FNERR ;OOPS.
BEGSY3: SKIPN EDFIL
EXIT ;No name, no edit
HLLM D,SRCFIL
HLLM D,DSTFIL
IFN BOOKMD, {
SKIPN BKPSW ;"READ" COMMAND USED?
JRST BEGSY4 ;NO
PUSH P,C
PUSHJ P,BKPRED ;LOOK FOR <FILENM>.BKP FILE (LIKE RPG FILE)
POP P,C
SETOM BOOKSW ;BKPSW IMPLIES BOOKSW
SETOM RDONLY ;BOOKSW IMPLIES RDONLY
JRST BEG1A
BEGSY4:
};END BOOKMD
TLNN D,740 ;ANY FILENAME, EXTENSION, OR PPN SPECIFIED?
JRST BEG1B ;NO
MOVEI G,(C)
; PUSHJ P,TMPWRT ;commented out because file may not exist
LDB C,[301400,,SYSCMD]
PUSHJ P,CRECHK
SETOM CREASW
MOVEI C,(G)
BEG1B: CAIE C,"←"
CAIN C,"→"
TROA F,COPY
JRST BEG1A
MOVEM C,TRMCHR#
MOVEI D,EDFIL2
PUSHJ P,FRD
JRST FNERR
MOVE G,[,SRCFIL-EDFIL2(A)]
CAIN C,"→"
HRRI G,DSTFIL-EDFIL2
; MOVE A,[-5,,EDFIL2]
MOVE A,[-7,,EDFIL2-2]
HRRZM A,@G
AOBJN A,.-1
HLLM D,EDFIL2(G)
SKIPN @SRCFIL
SETOM CREASW
BEG1A: PUSHJ P,TYIT
JRST BEG3
BEG2: PUSHJ P,TYI
JRST BEG3
JRST BEG2
FLOSE: SUB P,[1,,1]
FNERR: OUTSTR [ASCIZ / ILLEGAL FILE SPECIFICATION./]
JRST FNF1
IFN BOOKMD, {
BEGBKP: SETOM BKPSW# ;BKPSW MEANS WE WERE STARTED BY "READ" CMD TO USE .BKP FILE
SETOM BOOKSW# ;BOOKSW MEANS WE ARE IN /B MODE--NO FILE MODIFYING ALLOWED
};END BOOKMD
BEGSY1: MOVE H,TYIPNT
SKIPN TCPNT
PUSHJ P,TMPRED
JRST BEGSY2
PUSHJ P,FRD
JFCL
MOVEM H,TYIPNT
HRLI D,FRDTMP
PUSHJ P,FRD0
JRST FNERR
TLNN D,FRDNAM
TLO D,FRDEXT ;TMPCOR filename had to have included extension
JRST BEGSY3
;BEG3 BEG4 DPYOK NDPYOK
BEG3:
; PUSHJ P,SNKON
PUSHJ P,DPYSKI
SKIPE CREASW
PUSHJ P,CREATE
BEG4: MOVEI D,@SRCFIL
MOVEI A,1
PUSHJ P,OPENI
JRST FNF
MOVE T,@SRCFIL+4
AOS SRCFIL+4
MOVEM T,@SRCFIL+4
SKIPN DIR
PUSHJ P,GETDIR
MOVE T,EDFIL+4
TRNN F,COPY
IOR T,@SRCFIL+4
ADDI T,1
HRRZM T,DIRPAG#
PUSHJ P,COPFIL
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPNOI
PUSHJ P,OPNLUZ
TRZE F,UPDTXT
PUSHJ P,OUTDIR ;GETDIR asking for dir updating--TV style dir found
PUSHJ P,SETHED ;Put filename into header blocks for displaying
MOVEI T,1 ;Standard default page to start with
MOVE B,PAGES ;Number of pages in file
SKIPN A,XDIRFG ;Was directory extended?
JRST NOXDI2 ;No
CAILE B,1(A) ;Were any pages added?
MOVEI T,2(A) ;Yes, default position in file is first new page.
NOXDI2: CAIN B,2 ;Exactly 2 pages?
MOVEI T,2 ;Yes, default is page 2
SKIPGE A,SPAGE ;Particular starting page requested?
MOVEI A,-1(T) ;No, use default
ADD A,DIRPAG
JUMPG A,.+2
MOVEI A,1
PUSHJ P,RDPAGE
JFCL
SKIPE MARKS ;Are there any line marks
PUSHJ P,XMPAGE ;Yes, so get last mark on page data
TRNE F,REDNLY!DIROK
JRST .+3
TRO F,COPY
JRST BEG4
SETZM DELFIL ;Don't want to delete file because of ∂ yet.
SETOM LSTPLC ;No place to go back to in new file (XBACKGO cmd).
SETOM PARCUR ;No place to go back to in new file (double arrow cmd).
SETZM TYIPNT
SETZM TYOPNT
SETOM LSTPAG ;Force display of page number on TTYs
TLO F,OKF ;Say OK when ready initially and when switching files
PUSHJ P,DPYCHK ;Initialize display unless just switching files
PUSHJ P,PGINIT
PUSHJ P,ABCRLF
SKIPN DPY
JRST NDPYOK
SETACT [BRKTAB,,[-1↔-1↔-1↔-1,,600000!SUPCCR!EMODE!ALLACT]]
;Suppress ctrl cr and turn on EMODE for 400s
MOVE T,BRKTAB+3
TRNN T,EMODE ;Was EMODE already on?
PUSHJ P,LOADMT ;Load null line to give us our 400s!
JFCL ;LOADMT skips if expanding a macro
NDPYOK:
; SKIPGE SRCFIL+1
SKIPE DPY ;Don't need to tell display user the file's name
JRST DPYOK
OUTSTR [ASCIZ /Editing /]
MOVEI D,EDFIL
PUSHJ P,FILTYP
MOVEI A,"/R"
IFN BOOKMD, {
SKIPE BOOKSW
MOVEI A,"/B"
};END BOOKMD
TRNE F,REDNLY
TYPCHR (A)
TYPCHR "
"
DPYOK: PUSHJ P,ZLIST
SKIPGE EDFIL+2
OUTSTR [ASCIZ /File has protection bit 400 on and so will not be saved by DART.
/]
MOVEI B,1 ;In case directory not updated.
SKIPN A,XDIRFG ;Has directory been updated in core for extended file?
JRST NOXDIR ;No
MOVNI B,1(A) ;Subtract former number of pages from new total
ADD B,PAGES ;Number of new pages added.
OUTSTR [ASCIZ/Directory in core has been updated for /]
JUMPLE B,NOXPAG ;No pages added
TYPDEC B ;Number of pages added
OUTSTR [ASCIZ/ pages /]
JRST NOXREC
NOXPAG: HLRE A,A ;Negative of number of records added.
MOVM A,A ;Make it positive
TYPDEC A
OUTSTR [ASCIZ/ records /]
NOXREC: OUTSTR [ASCIZ/added to file.
/]
MOVEI B," U"⊗1+1
NOXDIR: MOVEM B,UFLAG
MOVEM B,UFLAG2 ;Let user know on header line that dir need updating
PUSHJ P,TMPWRT
IFN BOOKMD, {
SKIPGE A,NEWBKP
OUTSTR [ASCIZ /Will create .BKP file.
/]
};END BOOKMD
HLRZ A,RPGLIN
TRNE A,376000
JRST MAIN
TRZN A,400000
JUMPG A,[MOVEM A,EDMOV↔MOVE D,CMDSP-1↔MOVEI A,↔JRST MAIN2]
SKIPN ZATT ;To preserve ATTACH status if file switching
PUSHJ P,ATTACH
JFCL
;MAIN MAIN1 MAIN2 FNF FNF1 FNF2
MAIN:
IFN DEBSW,<
SKIPE CHKMOD
PUSHJ P,CHECK
SKIPE CHKMOD
JRST MAIN1
PUSHJ P,FSCHK
JFCL
SKIPN SHFMOD
JRST MAIN1
SKIPGE SAVMOD
PUSHJ P,SAVIT
PUSHJ P,MOVIT
PUSHJ P,FSCHK
JFCL
MAIN1:>
TRZ F,EDITM!EDBRK
SKIPE MACPNT ;Macro expansion in progress?
TLZ F,OKF ;Yes, don't say OK
TLZE F,OKF
OUTSTR[ASCIZ/ OK /]
PUSHJ P,BEEPCK ;See if we should beep him now.
MOVEI DSP,CMDSP
PUSHJ P,CMDIN
JFCL
PUSHJ P,BEEPST ;Remember time started processing command.
TLZ F,TF1 ;I don't think anyone counts on this except maybe justify routines
MAIN2:
IFN DEBSW,<
EXCH D,LSTCOM#
EXCH D,LSTCO2#
EXCH D,LSTCO3#
EXCH D,LSTCO4#
EXCH D,LSTCO5#
EXCH D,LSTCO6#
EXCH D,LSTCO7#
MOVE D,LSTCOM
EXCH A,LSTARG#
EXCH A,LSTAR2#
EXCH A,LSTAR3#
EXCH A,LSTAR4#
EXCH A,LSTAR5#
EXCH A,LSTAR6#
EXCH A,LSTAR7#
MOVE A,LSTCHR# ;The last characters typed
EXCH A,LSTCH1#
EXCH A,LSTCH2#
EXCH A,LSTCH3#
EXCH A,LSTCH4#
EXCH A,LSTCH5#
EXCH A,LSTCH6#
EXCH A,LSTCH7#
MOVE A,LSTARG
HRLM F,LSTARG ;To preserve NEG!REL flags
>
PUSHJ P,(D) ;Note that LININS and EDIT also call command
TLO F,OKF ; routines (through EDGL3) and know of only
JRST 2,@[MAIN] ; three possible returns (direct, skip, and
JRST MAIN2 ; double skip)
FNF: PUSHJ P,EXTCHK
JRST BEG4
PUSHJ P,ABCRLF
MOVEI D,LKUP
PUSHJ P,FILERR
FNF1: TRZ F,COPY
CLRBFI
FNF2: JSP P,INIT1 ;Now we always do this to re-initialize things
SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]]
PUSHJ P,MACSTP ;Terminate any macro expansion.
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Try again (ALT to abort). File? /]
SKIPN TYIPNT
JRST BEG1
SETZB T,TYIPNT
SKIPN TT,RSPNT
SKIPE TT,TCPNT
PTLOAD T
JRST BEG1
;CMDIN CMDLUP CMDEX CMDEDR XCMDX CMDX CMDX2 ILLATT ILLAT1 CMDEXS CMDLU2
CMDIN: TRZ F,ARG!REL!NEG
SETZB A,C
EXCH C,COMCHR#
JUMPN C,CMDEX ;Do we have a saved chr. ?
PUSHJ P,CMDRD ;No. Read a new one.
CMDEX: TLZA F,TF1 ;Flag not from search string activation
CMDEXS: TLO F,TF1 ;Here from SRACT with activator
CMDLU2: LDB B,[70200,,C] ;Get its ctrl bits.
TRZ C,¬177
;Save data for TELLME file
MOVEI T,0
TRNE B,1 ;Is CONTROL bit on?
ADDI T,"α"
LSH T,7
TRNE B,2 ;Is META bit on?
ADDI T,"β"
LSH T,7
MOVEM T,LSTCHR ;Save for storing at MAIN2 time
HRRZ T,C ;May be something in left half
ADDM T,LSTCHR ;Add Char.
MOVSI E,EDOK
LSH E,(B)
TDNE E,CTAB(C) ;Is it a line editor command ?
JRST CMDED ;Yes.
CMDEDR: SKIPA D,@CTAB(C) ;Get dispatch tbl. entry.
XCMDX: MOVEI E,
CMDX: TLNE D,37 ;Is this a 2-level dispatch ?
MOVE D,@D ;Yes. Get final disp. addr.
TDNE E,D ;E has bit representing cmd bucky bits.
JRST CMDERR ;Cmd is illegal with given bucky-bit combination.
JUMPL D,(D) ;Dispatch immediately on some commands.
TRNN F,ARG
MOVEI A,1 ;If no repeat argument typed, assume 1.
CAILE A,777776 ;Was CAILE A,=510
MOVEI A,777776 ;Was MOVEI A,=510
TRNE F,NEG
MOVN A,A
TLNN D,NORDO ;Is this command illegal in READONLY mode?
JRST CMDX2 ;No.
CAMN D,UPDCMD ;Yes. Is this the UPDATE command?
JRST CMDX3 ;Yes, it is legal even given from the directory page
TRNE F,EDDIR ;Are we editing the directory page?
JRST ILLDIR ;Yes
CMDX3: TRNE F,REDNLY ;No, are we in READONLY mode?
JRST ILLRDO ;Yes
CMDX2: TLNE D,NOATT
TRNN F,ATTMOD
JRST POPJ1
TLNE F,TF1 ;Here with search string activator?
CAME D,CMDSP+%COLON ;Yes, is this the colon command?
JRST ILLATT ;No, illegal in attach mode
JRST POPJ1 ;Currently here only with ⊗F⊗: in attach mode
CMDLUP: PUSHJ P,CMDRD ;Here after arg--read next char of command
JRST CMDLU2
ILLATT: JSP A,ILLMES
ILLAT1: ASCIZ /IN ATTACH MODE/
;CMDEDX CMDED CMDRD MINUS PLUS NUMS INFIN ALTSET
;Here with line-editor-entering command from line editor!
;Must have given decimal arg or been at end of line.
CMDEDX: JUMPE B,CMDERR ;No bits, no command
JRST CMDEDR ;With bits you get command
;Here with line-editor-entering command.
CMDED: SKIPN DPY ;We have a command to be passed to the line editor.
JRST CMDEDR ;Has to be a display.
JUMPL DSP,CMDEDX ;Jump if coming from line editor
MOVE D,-1(DSP)
TLNE F,TF1 ;Here with search string activator?
JRST CMDX ;Yes, line editor command is ok
TLNE F,NULLIN!PMLIN!OFFEND ;If this is an empty line,
JUMPN B,CMDERR ; and there were control bits, then forget it
JRST CMDX
CMDRD: JUMPL DSP,CTYI1 ;Don't update display if coming from line editor
PUSHJ P,DISP ;Update display, if needed.
XCT CHRTST ;Arg. to DISP
TRNN F,ARG!REL ;Don't output CRLF in middle of arg
PUSHJ P,CMDCRL ;See if we need a CRLF
JRST CTYI1 ;Read a character from TTY (in char mode) or ASCII string.
MINUS: TRC F,NEG
PLUS: TRO F,REL
JRST CMDLUP ;Loop back to get actual command.
NUMS: TRO F,ARG
IMULI A,12
ADDI A,-"0"(C)
JRST CMDLUP
INFIN: TRO F,ARG
MOVEI A,-1
JRST CMDLUP
ALTSET: MOVEI D,CPOPJ
POPJ P,
;CMDERR ERR PPJ1CR POPJ1C POPJ1 CPOPJ ICHTAB ILLRDO ILLDIR ILLBK ILLMES ILLMS2 ERRX ILLBK PRNTCH
CMDERR: JSP D,ERRX
ERR: PUSHJ P,ABCRLF ;Get to left margin
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR [ASCIZ/UNRECOGNIZED CONTROL CHARACTER -- /]
TRNE B,1
OUTSTR [ASCIZ /<ctrl>/]
TRNE B,2
OUTSTR [ASCIZ /<meta>/]
PUSHJ P,PRNTCH ;Print character in C using ICHTAB if non-printing char.
PUSHJ P,MACSTP ;Terminate macro expansion.
PPJ1CR: OUTSTR [ASCIZ /
/]
POPJ1C:
CPOPJ1: ;Occasionally someone uses the wrong name for this.
POPJ1: AOS (P)
CPOPJ: POPJ P,
ICHTAB: FOR X IN (tab,lf,vt,ff,cr){[ASCIZ /<X>/]
}
ILLRDO:
IFN BOOKMD, {
SKIPE BOOKSW
JRST ILLBK
};END BOOKMD
JSP A,ILLMES
ASCIZ \IN /R MODE\
ILLDIR: JSP A,ILLMES
ASCIZ /ON DIRECTORY PAGE/
IFN BOOKMD, {
ILLBK: JSP A,ILLMES
ASCIZ \IN /B MODE\
};END BOOKMD
ILLMES: JSP D,ERRX
ILLMS2: PUSHJ P,ABCRLF ;Get to left margin.
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR [ASCIZ/ILLEGAL /]
OUTSTR (A)
OUTSTR [ASCIZ /.
/]
PUSHJ P,MACSTP ;Terminate macro expansion
JRST POPJ1C
ERRX: POPJ P,
PRNTCH: MOVEI B,(C) ;Jim Dandy way to print a character, even
ROT B,-7 ; if it is a non-printing char.
CAIG C,15
CAIGE C,11
TROA B,B
HRRI B,@ICHTAB-11(C)
CAIN C,40
HRRI B,[ASCIZ /<space>/]
CAIN C,177
HRRI B,[ASCIZ /<bs>/]
OUTSTR (B)
POPJ P,
;INIT INIT0 INIT1 NOLOWC INI1
INIT: SETZM RPGACS
MOVE [RPGACS,,RPGACS+1]
BLT RPGACS+17 ;CLEAR ACS FROM ALL BUT RPG STARTUP
INIT0: SETZM TYIPNT
SETZM TCPNT
SETZM SYSCMD
SETZM ZDATA ;This avoida a needless message on ET starts
SETZM ESCI2 ;Haven't been interrupted by ESC I.
ESSAY,< SETZM ESEPSY>
MOVNI A,4
FOR X IN (BOTDSH,BOTSTR,TOPDSH,TOPSTR) ;Set serial values
{ HRRZM A,X+TXTSER
ADDI A,1
}
MOVEM P,PDL ;SAVE RETURN ADDRESS WHERE WE CAN POPJ
MOVEI
MOVEI 17,1
BLT 17,17 ;CLEAR REAL AC'S
MOVE P,[-LPDL+1,,PDL] ;SET UP STACK (RETURN HAS BEEN PUSHED)
RESET ;CLEAN UP SYSTEM ASPECTS OF JOBS
MOVE A,[ZVARS,,ZVARS+1]
BLT A,EVARS
SETOM DLINES ;Make sure trailer values get set later
SETOM DCURPG
SETOM DPAGES
SETOM DROOM
MOVSI A,400000 ;Very unlikely value will force this one out
MOVEM A,DBLOAT
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
IFN MACDWP,<
PUSHJ P,MFSCLR ;Init. macro free stg.
>;MACDWP
ESSAY,< PUSHJ P,ESINIT ;ESSAY initialization>
MOVE T,[PUSHJ P,UUOH] ;OUR UUO HANDLER
MOVEM T,41
MOVEI T,TSINT ;ADDRESS OF INTERRUPT HANDLER
MOVEM T,JOBAPR
MOVEI T,JBICNI ;USE DIFFERENT THREE WORDS FOR NEW INTS
MOVEM T,JOBINT↑
MOVE T,[JRST WRBF3]
MOVEM T,XSETO
SETOM TTYNUM ;Force DPYCHK to initialize dpy
SETOM DPY ; "
MOVEI T,"→"*2+1
MOVEM T,ARRON#
MOVEI T,220000 ;ENABLE FOR PDLOV AND MPV
APRENB T,
MOVSI T,4 ;ENABLE FOR ESC I INTS ON NEW SYSTEM
INTENB T,
ACCTIM T, ;Get date (left half) and time (right half)
MOVEM T,DATBLK# ;Date is OK as is
HRRZS T ;but must fix time.
IDIVI T,=60 ;Convert to minutes
HRRM T,DATBLK
MOVEI T, ;AND USER'S REAL NAME
GETPPN T,
MOVEM T,RPPN#
MOVEI T, ;AND USER'S ALIAS
DSKPPN T,
MOVEM T,PPN#
MOVE T,PARSYM ;Get default parenthesis symbols.
HLRZM T,LEFTC
HRRZM T,RITEC
SETOM BEEPNO
SETZM DIR
SETOB T,FIRPAG
AOBJN T,.+1
SETCAM T,SUBONE# ;-1 if KL-10. -2,,-1 if KA-10. For substitution.
;SETUP TABLE VBBITS TO HAVE A BIT ON FOR EACH CHARACTER WHICH DOESN'T HAVE
;ONE OF THE FOLLOWING BITS ON: LETF, LT2F, NUMF
;TABLE IS THE LEFTMOST 32 BITS OF 4 WORDS
MOVSI A,LETF!LT2F!NUMF
MOVEI B,40
MOVEI C,176
MOVEI E,VBBITS+4-1
INI1: TDNN A,CTAB(C)
IORM B,1(E)
JUMPL B,[MOVEI B,20↔SOJA E,.+2]
LSH B,1
SOJG C,INI1
MOVE T,FABITS+1
ANDM T,VBBITS+1
PUSHJ P,BITCNT
HRLZM T,VBBITS
MOVE T,[[LETF!LT2F!NUMF,,]-BEG+400000,,CTAB]
MOVEM T,5(E)
; MOVE A,[-5,,EDFIL]
MOVE A,[-7,,EDFIL-2]
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
IFN PURESW,{
SKIPL JOBHRL↑
JRST NOTPUR
PUSHJ P,CHKUP ;Make sure upper segment is ok before we start
CAME T,CHKSUM
PUSHJ P,FUCKED
NOTPUR:
};PURESW
IFG DEBSW-PURESW,{
SKIPN PURFLG
JSP E,PURINI
}
JRST FSINI ;GO INITIALIZE FREE STORAGE
IFN PURESW,{
FUCKED: OUTSTR [ASCIZ/
***** UPPER SEGMENT CHECKSUM FAILURE!!!! *****
I suggest you KILL the upper segment and announce this publicly.
Perhaps then find a wizard. Type CONTINUE to continue at your own risk.
(Checksum difference in AC 15; negative difference in AC 16.)
/]
SETO TT,
BEEP TT,
CLRBFI
SUB T,CHKSUM ;Leave difference in an AC
MOVN TT,T ;Other difference in another AC
EXIT 1,
POPJ P,
};PURESW
;Get here if COPCHK failed or if user refuses to let us reformat a file
INIT1: MOVEM P,PDL ;SAVE RETURN ADDRESS WHERE WE CAN POPJ
MOVE P,[-LPDL+1,,PDL] ;SET UP STACK (RETURN HAS BEEN PUSHED)
MOVE A,[-7,,EDFIL-2]
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
ANDI F,REDNLY!ATTMOD ;Only relevant flags when switching files
TRNN F,REDNLY
SETZM RDONLY ;Preserve READONLY mode if from λ cmd
SETZM CREASW
SETZM QUIETF
SETZM BOOKSW
SETZM DIR ;For good measure
SETZM SLINE
SETZM SPAGE
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
POPJ P,
;CMDSP
;MAIN COMMAND DISPATCH - INDEXED INTO VIA CTAB
;The CC macro, as here defined, is used to associate relative table addresses
;with the associated command characters. For a more detailed explanation see
;the comment for CTAB on page 106.
;See COMMAND DISPATCH FLAGS and their explanations on page 4.
DEFINE CC !(A){%!A←←.-CMDSP} ;TAGS FOR CTAB (PHASE 0 WOULD DO IF :: WORKED)
;rel.
;addr. for
; NOATT+EDOK*16,,EDSNK ;-2
NOATT+EDOK*10,,EDIT ;-1
CMDSP: SETZ CMDERR ;0 nul
DOEDIT!SSCMD,,NMVAR1 ;1 rubout
,CRDSP(B) ;2 CR
SETZ CMDERR ;3 LF
SETZ CMDERR ;4 TAB
FORMF ;5 FF
400000!NOEDIT,,ALTSET ;6 ALT
SETZ CMDERR ;7 letter
NOEDIT!NOATT,,SEMICO ;10 ;⊗
; SETZ CMDERR ;10 ;⊗
SETZ NUMS ;11 digits
DOEDIT,,TOP ;12 ∧
REPEAT 5,<SETZ CMDERR> ;13 thru 17 reserved for special find symbols
; ¬ ⊂ ⊃ ∀ ≡
DOEDIT,,BOT ;20 ∨
SETZ INFIN ;21 ∞
SETZ CMDERR ;22 |
CC(A) DOEDIT!SACMD!SSCMD!MSGCMD,,ATTACH
CC(B) NOEDIT!DOEDIT,,GLUP
CC(C) DOEDIT!SACMD!SSCMD,,ATTCOP
CC(D) SACMD!NOEDIT!NOATT,,DELLIN
CC(E) GETOUT
CC(F) DOEDIT,,FINDIT
; CC(G) HOMEG
CC(H) HOMEF
CC(I) NOEDIT!NOATT,,DUBLCR
CC(J) NOEDIT!DOEDIT,,JMP
CC(K) ATTKIL
CC(L) GOLINE
CC(M) XMARK
;N,O unused
CC(P) SSCMD,,NEWPAG
CC(Q) DOEDIT!NOATT,,CONTQ
CC(R) ATTREP
;S unused
CC(T) NOEDIT!DOEDIT,,GLDOWN
CC(U) SSCMD!DOEDIT,,NMVAR1
CC(V) NOEDIT!DOEDIT,,DRAW
CC(W) DOEDIT,,WIND
CC(X) SETZ EXTEND
CC(Y) DOEDIT!NOEDIT,,MACCAL
CC(Z) NOATT,,ZLINE
CC(VT) VERTAB
CC(PLS) SETZ PLUS
CC(MIN) SETZ MINUS
CC(LT) DOEDIT,,LT
CC(GT) DOEDIT,,GT
CC(LE) DOEDIT,,LTE
CC(GE) DOEDIT,,GTE
CC(DA) NOEDIT!NOATT,,DWNARR
CC(UA) NOEDIT!NOATT,,UPARR
;CC(.) NOEDIT!DOEDIT,,WRPAGE
CC(.) WRPAGE
;CC(FF) SSCMD!DOEDIT,,FORMF ;I don't know what this ever did--ME 8/22/75
CC(LA) LFARR
CC(RA) RTARR
CC(EPSIL) EPSIL
CC(LAMBDA) LAMBDA
ESSAY,<
CC(FRALL) ESCOMT
>
; CC(PI) LAMBDG
CC(QUERY) QUERY
CC(EXIST) DOEDIT!NOEDIT,,EXIST
CC(BSLAS) NOATT!DOEDIT,,BSLAS
CC(ASTER) DOEDIT,,ASTER
CC(COLON) SSCMD!NOEDIT!NOATT,,COLON
CC(PARL) NOEDIT!NOATT,,PARL
CC(PARR) NOEDIT!NOATT,,PARR
CC(PARB) NOEDIT!NOATT,,PARB
CC(MSG) DOEDIT,,MSG
;XCMDS XDISP MCMDS MDISP
BEGIN XDISPS ;TO FLUSH MACROS
GLOBAL D ;GRRRR
;EXTEND MODE COMMAND TABLE (MUST BE ALPHABETICAL)
;See COMMAND DISPATCH FLAGS and their explanations on page 4.
DEFINE XCMD{FOR X IN (ALIAS,<ALIGN,SACMD>,<APPEND,NOATT>
,<AUTOBURP,NOEDIT!DOEDIT>,BACKGO,BEEPME,<BREAK,SACMD>,BURP,<CANCEL,DOEDIT>
,<CENTER,SACMD>,<CLOSE,,CLOSIT>,CRUNCH,<DDTGO,NOEDIT!DOEDIT>,<DEFINE,,MACDEF>
,<DELETE,NOATT!NORDO>,<DIRED,NOATT,GODRD>,DPYALWAYS,DPYSKIP,<DRAW,NOEDIT!DOEDIT>
,<DRD,NOATT,GODRD>,<ENTER,,EPSIL>,<EPSILON,,EPSIL>,<EXIST,DOEDIT!NOEDIT>
,<FIND,DOEDIT>,<GORPG,NOATT>,<INDENT,SACMD>
,<INSERT,↑INSCMD::NOATT!NORDO>,<JFILL,SACMD>,<JGET,SACMD>
,<JJSTOP,SACMD>,<JOIN,SACMD>,<JSTOP,SACMD>
,<JUST,SACMD>,LAMBDA,LINCNT,<LOOKUP,,LAMBDA>,<LPAREN,NOEDIT!NOATT>
,<M,NORDO,MARK>,<MAIL,SACMD>,<MARK,NORDO>,<MSG,DOEDIT>
,<PAREN,NOEDIT!DOEDIT>,<PARTIAL,DOEDIT,MSG>
,PPSET,PROTEC,<QUIT,DOEDIT>,READONLY,READWRITE,<REMIND,SACMD>
,<RPAREN,NOEDIT!NOATT>,<RSYS,DOEDIT>,<RUN,DOEDIT>,<SAVE>
,<SEND,SACMD>,<SPOOLC,SACMD>,TELLME,<TJFILL,SACMD>,<TJGET,SACMD>,<TJUST,SACMD>
,TMPCOR,TV,<TYPE,SACMD>,<UPDATE,↑UPDCMD::NORDO>,<XSPOOL,SACMD>)}
DEFINE MCMD{FOR X IN (READONLY,READWRITE)}
DEFINE CMDM(A,B,C){<SIXBIT /A/>
}
DEFINE DISPM(A,B,C){B,,IFIDN {C}{}{A;}C
}
FOR @! Y IN (X,M)
{ ,Y!DISP-Y!CMDS(D)
↑Y!CMDS:Y!CMD
{ CMDM X
}↑N!Y!CMDS←←.-Y!CMDS
↑Y!DISP:Y!CMD
{ DISPM X
}IFN .-Y!DISP-N!Y!CMDS{!}
}
BEND XDISPS
;EXTEND EXTEN1 EXTL0 EXTL EXTL1 EXTL2 EXTL3
EXTEND: MOVE E,[-NXCMDS,,XCMDS]
MOVE T,B ;Reconstruct the initial activator
LSH T,7
ADD T,C
MOVEM T,XSAVE# ;Save for possible use in repeat command
EXTEN1: SKIPE DPY
PUSHJ P,CMDCRL ;Put out CRLF if line long on display
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
OUTSTR [ASCIZ/ COMMAND? /]
JUMPGE DSP,.+2 ;From line editor?
TRO F,EDITM ;Yes, force DISP to set up line editor
PUSHJ P,DISP
XCT LINTST
TRZ F,EDITM ;We are never supposed to have EDITM on here
PUSHJ P,LECLR ;Make sure line editor is in page printer
MOVE D,[440600,,TT]
MOVEI TT,
MOVE G,[440600,,XMSK]
SETZM XMSK#
MOVEI T,77
MOVE Q,[440700,,EXTBUF]
EXTL0: PUSHJ P,TYIU
JRST EXTNUL
TLNN T,LETF!NUMF!LT2F
JRST EXTL0
JRST EXTL1
EXTL: PUSHJ P,TYIU
JRST EXTLK0
EXTL1: CAME Q,[100700,,EXTBFE-1] ;DON'T CAUSE CLOBBERAGE IF HE'S VERBOSE
IDPB C,Q
TLNN T,LETF!NUMF!LT2F
JRST EXTL2
TLNN D,770000
JRST EXTL ;IGNORE AFTER 6
SUBI C,40
IDPB C,D
IDPB T,G ;GENERATE MASK
JRST EXTL
EXTL2: MOVEM Q,EXTPNT#
EXTL3: PUSHJ P,TYI
JRST EXTLK
CAME Q,[100700,,EXTBFE-1]
IDPB C,Q
JRST EXTL3
;EXTLK0 EXTLK EXTAMX EXTAMB EXTNUL EXTNF EXTNF2 EXTAM2 EXTBUF EXTBFE MACABT
EXTLK0: MOVEM Q,EXTPNT
EXTLK: MOVEI T,
IDPB T,Q ;TERMINATOR FOR OUTSTR
CAIN C,175
JRST EXTNUL
MOVE D,E
CAMLE TT,(D) ;FIND FIRST COMMAND ≥ HIS
AOBJN D,.-1
JUMPGE D,EXTNF ;NONE
CAMN TT,(D) ;Is it an exact match?
JRST EXACTM ;Yes, win quick
MOVE T,XMSK
AND T,(D)
CAME T,TT
JRST EXTNF ;DOESN'T MATCH - HE LOSES
MOVE T,XMSK
AND T,1(D)
CAMN T,TT
; JRST EXTAMB ;NEXT ONE WORKS ALSO - NOT UNIQUE
PUSHJ P,EXTAMX
EXACTM: MOVE T,LSTCHR ;Report two characters (caps)
LSH T,1
LSHC T,6 ;Add first character
LSH T,1
LSHC T,6 ;Add second character
ADDI T,10040 ;Back to ascii
MOVEM T,LSTCHR
MOVE D,@-1(E)
JRST XCMDX
EXTAMX: MOVEI T,-XCMDS(D)
ADDI T,XDISP
MOVE TT,(T)
CAMN TT,1(T)
POPJ P,
POP P,T
EXTAMB: MOVEI D,EXTAM2
POPJ P,
EXTNF: JSP D,CPOPJ
EXTNF2: SKIPA T,[[ASCIZ/UNKNOWN COMMAND -- /]]
EXTAM2: MOVEI T,[ASCIZ/AMBIGUOUS COMMAND -- /]
PUSHJ P,ABCRL0
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR (T)
MOVEI T,
IDPB T,EXTPNT
OUTSTR EXTBUF ;WHATEVER HE TYPED
PUSHJ P,MACSTP
JRST PPJ1CR
EXTNUL: JSP D,CPOPJ
ANDI C,177
CAIN C,15
POPJ P,
MACABT: OUTSTR [ASCIZ / ABORTED. /]
PUSHJ P,MACSTP ;Terminate macro expansion
JRST POPJ1
IMPURE
EXTBUF: BLOCK 30
EXTBFE←←.
PURE
;READON ROSET READWR NORDWR CANCEL SNKOFF SNKON DPYALW DPYSKI NORDOW
READON:
IFN BOOKMD, {
SKIPE BOOKSW
JRST NORDOW ;CANT CHANGE TO READONLY FROM /B MODE
};END BOOKMD
TRNE F,REDNLY
POPJ P,
PUSHJ P,CLOSIT
SETOM RDONLY
TRO F,REDNLY
TRNE F,WRITE ;Don't type out message if meaningless
OUTSTR [ASCIZ /
To save changes, reenter READWRITE before switching pages./]
MOVEI T,<BYTE(7),,,"/","R"(1)1>
ROSET: MOVEM T,ROFLG
MOVEM T,ROFLG2
JRST DSHED ;Force display of header line.
READWR:
IFN BOOKMD, {
SKIPE BOOKSW
JRST NORDOW ;CANT CHANGE TO READWRITE FROM /B MODE
};END BOOKMD
TRNE F,FILLUZ
JRST NORDWR
SETZM RDONLY
MOVEI T,1
TRZE F,REDNLY
JRST ROSET
POPJ P,
IFN BOOKMD, {
NORDOW: SORRY Cannot change from BOOKMODE (/B).
JRST POPJ1
};END BOOKMD
NORDWR: SORRY File not formatted.
JRST POPJ1
CANCEL: MOVE A,ARRL
MOVEM A,SLINE
PUSHJ P,FLSPAG
PUSH P,TOPWIN
MOVE A,FIRPAG
PUSHJ P,REREAD
POP P,A
JRST SETWIN
DPYALW: SKIPA T,[¬<JFCL>] ;ALWAYS UPDATE DISPLAY
DPYSKI: HRLOI T,<(¬<INSKIP>)> ;ONLY UPDATE DISPLAY IF NO INPUT READY
SETCAM T,CHRTST#
MOVNM T,LINTST#
POPJ P,
;DDTGO R DRAW DRAWX LINCNT DDTRET
DDTGO: SKIPN TT,JOBDDT
JRST EXTNF2
TRNN TT,400000
JRST .+3
UNPURE
FATAL COULDN'T UNPURIFY UPPER
LDB T,[331100,,1(TT)]
CAIN T,<PUSHJ>⊗-33
JRST DDTG2 ;DDT - LOSE
HRRZ TT,-3(TT)
MOVE T,MASK
MOVEM T,1(TT)
NOESS,< MOVE T,[441100,,[BYTE (9)"E","T","V",200+":","2","4",200+"I"]]>
ESSAY,< MOVE T,[441100,,[BYTE (9)"E","S","S","A","Y",200+":","2","4",200+"I"]]>
MOVEM T,-1(TT)
DDTG2: PUSHJ P,WIPE
PPSEL 2 ;Select piece of paper 2
PGACT ;Zero address field means invisible glass
MOVEI T,CPOPJ ;SGK 10-FEB-75 RETURN FROM RAID VIA <CTRL>P
MOVEM T,JOBOPC
;SGK SETZM JOBOPC
PUSHJ P,@JOBDDT ↔R←←CPOPJ
DDTRET: DPYOUT 17,[[0]↔0]
PUSHJ P,BEEPST ;No need to beep now.
; PGSEL
; TLZ F,ARRPG ;flushed because of displaying search page number on POG 2
IFG DEBSW-PURESW,{PUSHJ P,PURCLC}
;ME PUSHJ P,@PPSET
SETZM BLNKL
MOVEI B,3 ;Force erasure of screen.
;ME JRST DRAWX
TRZ F,ARG!REL ;Don't wait after display
DRAW: PUSHJ P,DPYCHK
PUSHJ P,@PPSET
SKIPE MACPNT
JRST DRAWM ;Called from inside macro, just update screen.
CAIN B,3 ;Don't erase screen unless both α and β are on.
PUSHJ P,WIPE
DRAWX: TRO F,DSPALL
SETOM LEPOS
DRAWM:
ESSAY,< SKIPE ESCGIS# ;¬0 MEANS TYPE αβ∀ INSTRUCTIONS OUT
OUTSTR [ASCIZ ↔
Type/Edit comment. Return with <CTRL>G. ↔]
SETZM ESCGIS>;ESSAY
PUSHJ P,DISP0
JFCL ;Force display out now
JUMPLE A,CPOPJ
TRNE F,ARG!REL ;Positive arg means wait that long after displaying
SLEEP A, ;Then wait number of seconds requested
POPJ P,
LINCNT: SETZM TYOPNT
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Line /]
TYPDEC ARRL
OUTSTR [ASCIZ / of /]
TYPDEC LINES
OUTSTR [ASCIZ / prints /]
MOVE Q,ARRLIN
HRRZ Q,TXTCNT(Q) ;Was MOVE Q,1(Q)
TYPDEC Q
OUTSTR [ASCIZ / columns. /]
MOVE TT,CURPAG
MOVE T,CHARS
SKIPN G,XPLST
JRST LINCN2 ;Only one page in core
LINCN4: HLRZ B,2(G) ;Get line number of pagemark
CAML B,ARRL
JRST LINCN3
HRRZ G,(G) ;Next pagemark
JUMPN G,LINCN4
MOVE T,CHARS ;Pointing to final in-core page
SUB T,XCHRS ;XCHRS is chars in non-final pages
JRST LINCN2
LINCN3: LDB T,[341000,,1(G)] ;Get record count for this page
IMULI T,200*5
LDB TT,[221200,,1(G)] ;Get excess char count
ADDI T,(TT)
HRRZ TT,1(G) ;Get page number
SUBI TT,1 ;This is chars for prev page
LINCN2: TYPDEC T
OUTSTR [ASCIZ / chars on page /]
TYPDEC TT
OUTSTR [ASCIZ /. /]
TRNE F,ATTMOD
JRST LINCN5
JRST POPJ1
LINCN5: SKIPN DPY
OUTSTR [ASCIZ/
/]
TYPDEC ATTNUM
OUTSTR [ASCIZ/ lines attached.
/]
JRST POPJ1
;GETOUT GETOU1 FINISH FINI1 FINI2 GORPG QUIT CLOSIT GODRD REOPEN CHKDEL
GETOUT: TRZE F,ATTMOD
JRST ATTEX
PUSHJ P,FINISH
IFN 1,<
GETOU1: DPYCLR
PUSH P,TOPWIN
SETZM BRKTAB+3 ;No special bits now.
SETACT [BRKTAB] ;Clear EMODE before returning to monitor.
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Bye/]
RELEAS DSKO,
SETZM JOBJDA+DSKO
PUSHJ P,BYE ;Do an EXIT 1,
JFCL ;BYE skips
PUSHJ P,REOPEN ;Now reopen the file.
PUSHJ P,BEEPST ;No need to beep now.
PUSHJ P,DPYINI ;He typed CONTINUE--now restore display.
POP P,A ;Get saved TOPWIN
JRST SETWIN ;And restore window position
>
IFN 0,<
GETOU1: CALLI
MOVE A,JOBFF
SOJ A,
CORE A, ;CORE BACK DOWN
PUSHJ P,TELLZ ;WHAT??
CALLI 12
>
FINISH: PUSHJ P,WRPAGE
PUSHJ P,CHKDEL ;See if we should delete this file (and do it, if so)
FINI1: TLZE F,ENTRD
CLOSE DSKO, ;MAKE SURE THE FILE GETS OUT
PUSHJ P,TMPWRT
IFN BOOKMD, {
SKIPE BKPSW ;STARTED BY "READ" COMMAND?
PUSHJ P,BKPWRT ;YES, WRITE OUT <FILENM>.BKP FILE
};END BOOKMD
FINI2: SKIPLE DPY
PPACT ;STOP ANDY FROM WRITING
MOVE T,PPSIZ
ADDM T,SCRSIZ ;ERASE PP TOO
PUSHJ P,WIPE ;BLAST THE SCREEN
SKIPE DDACT ;WAIT FOR WIPE
DPYOUT [0↔0]
POPJ P,
GODRD: PUSHJ P,FINISH ;START UP DIRED
MOVEI
MOVEI 17,1
BLT 17,17
MOVEI A,[SIXBIT /SYS DIRED DMP/ ↔ 1 ↔ 0]
SWAP A,
PUSHJ P,TELLZ
GORPG: PUSHJ P,FINISH
MOVEI
MOVEI 17,1
BLT 17,17 ;SOMEWHERE IN HERE GARBAGE CAN CAUSE STORAGE MAP
MOVEI A,[SIXBIT /SYS SNAIL DMP/↔1↔0]
SWAP A,
PUSHJ P,TELLZ
QUIT:
IFN 0,< ;Now we allow him to get back into E by CONTINUE
PUSHJ P,FLSPAG
>
PUSHJ P,FINI1
JRST GETOU1
CLOSIT: TLZN F,ENTRD
POPJ P,
RELEAS DSKO,
SETZM JOBJDA+DSKO
REOPEN: MOVE T,ICHN
CAIE T,DSKO
POPJ P,
MOVE A,IBLK
MOVEI D,EDFIL
MOVEI C,DSKO
PUSHJ P,IOPEN
PUSHJ P,OPNLUZ
POPJ P,
CHKDEL: TRNN F,REDNLY
SKIPN DELFIL ;Was last text of file deleted by ∂ command?
POPJ P, ;No
SETZM DELFIL# ;Make sure we don't screw someone later somehow
HLRZ TT,EDFIL+1 ;Yes
MOVE T,EDFIL+3
CAIN TT,'MSG' ;Is this a .MSG[2,2] file?
CAME T,[' 2 2']
POPJ P, ;No
RENAME DSKO,[0↔0↔0↔' 2 2'] ;Yes, delete whole file now.
OUTSTR [ASCIZ/ Failed to delete empty file. /]
POPJ P,
;NEWPAG NEWPG0 NEWPG1 NEWPG2 NEWPG3 NEWPG4 REREAD PGINIT PGERR PGERR1 NEWPG5
;We enter here when we ask for a new page. This requires a DIRECTORY lookup.
;The start of the directory is pointed to by DIR and its end by DIREND while
;the current page is pointed to by DIRPT. The directory is stored much as
;any other page of data except for a few changes to enable the free storage
;routines to spare it from garbage collections.
JRST DIRSRC
NEWPAG: CAIE B,3 ;αβ means force out current page(s) no matter what.
JRST NEWPG2 ;Get to line 1 of given page, which might be in core already
TRNE F,NEG
SUB A,XPAGES
TRNE F,ARG
TRNE F,REL
ADD A,CURPAG
NEWPG0: PUSH P,A
PUSHJ P,WRPAGE ;OUT WITH THE BAD PAGE
PUSHJ P,FLSPAG
AFSHIT←←0 ;BET YOU CAN'T GUESS WHAT THIS MEANS.
IFN AFSHIT,< ;THE FOLLOWING EXCERCISE IN BAD TASTE. 3-29-74
PUSH P,B
DATE A,
IDIVI A,=31*=12
CAIN B,=93
PUSHJ P,[AOS A,NEWFO1# ;SO IT WON'T BE TOO BOTHERSOME
TRNE A,3
POPJ P,
MOVE A,[1000,,[1B18]] ;SET TEMPORARY TO CHANNEL 22 (OCTAL)
VDSMAP A,
JFCL ;PROBABLE SKIP RETURN
MOVE A,[700015,,2] ;TEMP AUDIO MAP TO CH 15. 1/2 SECOND
ADSMAP A,
MOVSI A,4000 ;RESET TO PERMANENT MAPPING
VDSMAP A,
JFCL
POPJ P,]
POP P,B
>;IFN AFSHIT
POP P,A
NEWPG1:
REREAD: SETZM DELFIL ;Don't delete this file--for CANCEL and maybe others
PUSHJ P,RDPAGE ;AND IN WITH THE GOOD
PUSH P,[PGERR]
SKIPE MARKS ;Are there any line marks
PUSHJ P,XMPAGE ;Yes, so get last mark on page data
PUSHJ P,CORCHK
PGINIT: MOVN A,GTDEL
;ME ASH A,-1 ;ME--now we center the starting line
ADD A,SLINE
PUSHJ P,SETWIN
MOVEI A,1
EXCH A,SLINE
PUSHJ P,SETARR
TRO F,DSPALL
POPJ P,
PGERR1: SUB P,[1,,1] ;Adjust stack--here from append
PUSHJ P,LINSE2 ;In case we did some appending
PUSHJ P,CLEARX ;See if X on top line should be turned off
PGERR: SORRY No such page.
JRST POPJ1
;Here to see if the page he wants is already in core.
NEWPG2: PUSHJ P,GPAGL ;Find out what page we are really on
TRNE F,ARG
TRNE F,REL
ADDI A,(T) ;Relative to "arrow page"
NEWPG5: CAMG A,CURPAG ;Enter here to go to line 1 of page A, maybe in core
CAMGE A,FIRPAG
JRST NEWPG0 ;Not in core, flush current page, get new one
SUB A,FIRPAG ;Find relative page in core desired
JUMPE A,NEWPG3 ;Easy if first page
MOVEI G,XPLST
HRRZ G,(G) ;Pointer to next pagemark
JUMPE G,NEWPG4 ;Better be a pagemark there
SOJG A,.-2 ;Count down till we get to right pagemark
HLRZ A,2(G) ;Get line number of pagemark
NEWPG3: AOJA A,SETARR ;Move arrow to line 1 of requested page
NEWPG4: SORRY <Page supposedly in core already, but I can't find it!!>
PUSHJ P,FBI ;Tell someone it happened, although it can't.
JRST POPJ1
;UNWIND WIND WIND1 LT GT LTE GTE TOP BOT JMP JMPJMP UPARR DWNARR SEMICO COLON CHKMOV CHKMV2 MIDDLE FORMF VERTAB VERTB2 JUMPGL
VERTAB: JUMPE B,UNWIND ;With no control bits, just like -W
TRNE F,ARG ;Any arg means do -nW
JRST UNWIND
TRNE F,NEG
JRST FORMF2 ;-VT means FF
VERTB2: MOVE A,TOPWIN ;Back up a window, possibly crossing page boundary
MOVE T,FIRPAG
CAMLE T,DIRPAG ;Can't backup beyond directory page.
CAILE A,1 ;Skip if we are currently viewing top of page.
JRST VERTB3
MOVE A,FIRPAG
SUBI A,1
PUSHJ P,NEWPG0 ;Back to previous page
TRZ F,NEG!REL
MOVE A,LINES
JRST WIND1 ;Get to the bottom of the page
FORMF: JUMPE B,WIND ;No control bits means just like W
CAIN B,2
JRST FINSRT ;META-FF means insert pagemark
TRNE F,ARG
JRST WIND ;With arg, just do W
TRNE F,NEG ;Does he want -FF?
JRST VERTB2 ;Yes
FORMF2: MOVE A,BOTWIN ;Forward a window, possibly crossing page boundary
MOVE T,CURPAG
CAMGE T,PAGES
CAMG A,LINES
SOJA A,WIND1 ;Just advance a window
MOVE A,CURPAG
AOJA A,NEWPG0 ;Go to beginning of next page
;Here for META-FF
FINSRT: MOVE D,INSCMD
PUSHJ P,XCMDX
JFCL
SOS (P) ;Make us return to the PUSHJ that called us
POPJ P, ; so we can then call XINSERT command
UNWIND: MOVNS A
JUMPN A,WIND0
WIND0C: PUSHJ P,WIND0A ;0L moves back a half window
JRST JMPJMP ;Make it a half-window move
WIND0B: AOJA A,WIND0C ;0W moves forward a half window
VERTB3: MOVNI A,1
WIND: JUMPE A,WIND0B
WIND0: JUMPGE A,WIND0A
ADDI A,1
WIND0A: MOVEI B,0
CAIE A,1 ;Special treatment for this case only.
JRST WIND2
MOVE B,ATTNUM ;To allow for space occupied by ATTACH
CAILE B,ATTMAX ;which may be 0 but
MOVEI B,ATTMAX ;which is never more than ATTMAX
MOVNS B
WIND2: ADD B,SCRSIZ
IMULI A,-3(B)
ADD A,TOPWIN
WIND1: CAML A,LINES
ADDI A,1
PUSHJ P,SETARR
CAMG A,TOPWIN
SUBI A,-3(B)
JRST SETWIN
LT: MOVNS A
GT: ASH A,2
MOVAR1: AOS (P)
JRST MOVARR
LTE: MOVNS A
GTE: IMUL A,GTDEL
JRST MOVARR
TOP: JUMPL A,BOT1 ;-5∧ means 5∨
JUMPE A,MIDDLE ;Zero means middle of screen
TOP1: MOVM A,A
ADD A,TOPWIN
CAMLE A,BOTWIN
MOVE A,BOTWIN
SOJA A,SETARR
BOT: JUMPL A,TOP1 ;-5∨ means 5∧
JUMPE A,MIDDLE ;Zero means middle
BOT1: MOVM A,A
MOVN A,A
ADD A,BOTWIN
CAMGE A,TOPWIN
MOVE A,TOPWIN
JRST SETARR
MIDDLE: MOVE A,BOTWIN ;Position arrow at middle of current screen
SUB A,TOPWIN
ASH A,-1 ;DIVIDE BY 2
ADD A,TOPWIN
JRST SETARR
JMPGL: TRO F,ARG ;Here from glitching command given from line editor,
MOVN A,B ; which means we shouldn't glitch arrow off screen
JMP: JUMPLE A,JMP1
TRNN F,ARG
JRST JMP0
ADD A,TOPWIN
CAMLE A,ARRL
JMP0: MOVE A,ARRL
JRST SETWIN
JMP1: MOVE B,ATTNUM
CAILE B,ATTMAX
MOVEI B,ATTMAX
JUMPL A,JMP2
MOVN A,SCRSIZ
ASH A,-1
SOJ A, ;Middle is one less than one half
ADD A,ARRL
ADDI A,3(B)
JRST SETWIN
JMP2: TRNN F,ARG
JRST JMP3
ADD A,BOTWIN
SOJ A,
CAMGE A,ARRL
JMP3: MOVE A,ARRL
ADDI A,3(B)
SUB A,SCRSIZ
JRST SETWIN
CHKMOV: JUMPGE A,CHKMV2
MOVE T,ARRL
SOJG T,CHKMV2
SUB P,[1,,1] ;Trying to move up from first line--abort and reedit line
TRNN F,EDITM
POPJ P, ;Do nothing if not from line editor
JRST REEDIT ;Go back to line editor
CHKMV2: TRNE F,EDITM
PUSHJ P,FNEDIT ;Finish edit by storing line's edited version.
PUSHJ P,MOVARR ;Get to correct line
SKIPE IMLDPY ;Don't try to edit on TTY
TLNE F,OFFEND!PMLIN!NULLIN ;Don't edit if no such real line
SUB P,[1,,1] ;We have moved the arrow, but don't edit anything
POPJ P,
UPARR: MOVNS A
DWNARR: PUSHJ P,CHKMOV
PUSH P,[1]
PUSH P,[211] ;SET FOR CTRL1-TAB
TLNE F,NULLIN
SETZM -1(P) ;ONLY CRLF - FLUSH THE CTRL-TAB (WILL LOSE AT END OF LINE)
JRST EDIT1
SEMICO: MOVNS A
CAIN C,";" ;Circle-ex dispatches to here too, but is illegal
JRST COLON
TRNN F,EDITM
JRST ERR ;Not from line editor--say illegal
JRST REEDIT ;Go back to line editor
JRST LBLSRC
COLON: PUSHJ P,CHKMOV
COLON1: HRRZ A,ARRLIN ;Pointer to new line to edit
ADD A,[440700,,LLDESC] ;Make byte pointer to its text.
SETZB B,TT ;B will count display columns, TT control-spaces needed
TRNE F,EDITM ;If not coming from line editor, go to beginning
COLON3: CAML B,EDPOS
JRST COLON4 ;That's far enough.
ILDB C,A
CAIN C,15 ;End of line?
JRST COLON4 ;Line not long enough, go to its end.
ADDI TT,1
CAIE C,11 ;Tabs move several columns
AOJA B,COLON3
ILDB C,A
CAIE C,11 ;Loop till found matching tab
AOJA B,.-2
CAMG B,EDPOS ;Did we pass the right column inside the tab?
JRST COLON3 ;No
SUBI TT,1 ;Yes, back up to beginning of the tab
COLON4: PUSH P,TT ;Number of control-spaces to position us in line.
PUSH P,[240] ;Control-space char
JRST EDIT1 ;Now go edit line
;This routine positions the window:
; 1) at the top of the page, if the arrow line will then appear no more than 4 lines
; below the middle of the window, or if the page takes less than a full window,
; 2) at the bottom of the page if the arrow line will then appear no more than 4
; lines above the middle of the window.
; 3) so that the arrow line will be in the middle of the window.
JMPJMP: MOVN A,ARRL
CAML A,[-25] ;Is it within 20 lines of the top of the page?
JRST JMP1 ;It is, so start at the top of the page
ADD A,LINES
CAIG A,25 ;Or within 20 lines of the end of the page?
JRST JMP1 ;It is, so go to the bottom of the page
MOVEI A,0 ;Well then put it at the middle of the window
JRST JMP
;MARKS XMARK XMPAGE XXADD XXSUB XPADD XPSUB XLALL XXARRL XXPAGE XXLINE
NMARKS←←27 ;Max. no. of marks.
IMPURE
XXARRL: 0 ;Holds line number at a page insertion or deletion
XXPAGE: 0 ;Holds index value to MARKS at first entry for current page
XXLINE: 0 ;Holds MARKS line number from first entry for current page
MARKS: BLOCK NMARKS
0 ;Table stop
-1 ;Sure stop
PURE
XMARK: TRNE B,2 ;Is it a make or remove mark?
JRST XMAKE ;Make (double-bucky)
SKIPN MARKS ;Are there any marks?
JRST XXNON1 ;No
MOVE D,ARRL
HRL D,CURPAG ;Get current location into mark-table format
CAMN D,MARKS ;Are we at the first mark?
SKIPE MARKS+1 ;And is it the only one?
JRST XMARK1 ;No
OUTSTR [ASCIZ /
There is only one MARK and you are there! /]
JRST PPJ1CR
XXNONE: OUTSTR [ASCIZ / There are no marks! /]
JRST POPJ1 ;Here from αβ0αβM
XXNON1: SORRY There are no marks!
JRST POPJ1 ;Here from αM
XFULL: SORRY MARK table is full!
JRST POPJ1
XTHERE: OUTSTR [ASCIZ / Already marked! /]
JRST POPJ1
XNOTF: OUTSTR [ASCIZ / Not marked! /]
JRST POPJ1
XMARK1: MOVEI E,0
TRNE F,NEG ;Backward search?
JRST XBACK ;Yes
CAML D,MARKS(E) ;Is D larger or equal to the largest?
MOVEI D,0 ;Yes so start over
CAMGE D,MARKS+1(E)
AOJA E,.-1 ;Stops because marks block is terminated by a -1
SOJLE A,XMOVE ;Do we need to go further?
SOJGE E,.-1 ;Back up another one
AOJA E,.-5 ;Woops, off upper end of table
XMOVE: PUSH P,E ;Found it.
HLRZ A,MARKS(E)
CAMN A,CURPAG ;Save time if on right page already.
JRST XMOVE3
PUSHJ P,NEWPG0 ;Go to right page.
POP P,A
HRRZ A,MARKS(A)
XMOVE2: PUSHJ P,SETARR ;Set arrow
JRST JMPJMP ;and readjust window
XMOVE3: POP P,A
HRRZ A,MARKS(A)
MOVE E,TOPWIN ;Test to see if new position is at a reasonable place
CAIL A,4(E) ;Between 4 below top
CAILE A,36(E) ;and 4 above bottom allowed
JRST XMOVE2 ;It is not within limits so readjust window
JRST SETARR ;Set arrow only
XBACK: CAMG D,MARKS(E)
AOJA E,.-1
SKIPG MARKS(E) ;Is this a legitimate entry?
MOVEI E,0 ;No so go to the top of the list
AOJGE A,XMOVE ;Do we need to go further?
AOJA E,.-3 ;Go down 1 and test if off bottom of active list
XMAKE: TRNE F,ARG
SKIPE A
JRST XWRITE ;Not a clear command
SKIPN MARKS ;Are there any marks?
JRST XXNONE ;No
XZERO: SETZM XXPAGE
MOVE A,[XXPAGE,,XXLINE]
BLT A,MARKS+NMARKS-1
OUTSTR [ASCIZ / All marks have been cleared. /]
JRST POPJ1
XWRITE: TRNE F,NEG ;Is it a delete?
JRST XDELET ;Yes
SKIPLE MARKS+NMARKS-1 ;Is table full?
JRST XFULL ;Yes
MOVE D,ARRL
HRL D,CURPAG ;Into form stored
MOVEI E,0
CAMGE D,MARKS(E)
AOJA E,.-1
CAMG D,MARKS(E)
JRST XTHERE ;A mark is already there
MOVE A,ARRL
CAMG A,XXLINE ;Is new mark later than XXLINE
JRST .+3 ;Yes
MOVEM A,XXLINE
MOVEM E,XXPAGE ;Reset for newly inserted mark
EXCH D,MARKS(E) ;Make room
JUMPLE D,.+2
AOJA E,.-2
POPJ P,
XDELET: MOVE E,XXPAGE ;Get starting place
MOVE D,ARRL
HRL D,CURPAG
XDEL2: CAMGE D,MARKS(E) ;Find entry
AOJA E,.-1 ;Try again
CAME D,MARKS(E)
JRST XNOTF ;It was not marked
MOVE D,ARRL
CAMGE D,XXLINE ;Is it the the latest on this page?
JRST XDEL4 ;No
HLRZ T,MARKS+1(E) ;Is it also the last one on this page?
CAME T,CURPAG
JRST XDEL3 ;This was the only one
HRRZ T,MARKS+1(E)
MOVEM T,XXLINE ;Only XXLINE needs fixing, XXPAGE will be unchanged
JRST XDEL4
XDEL3: SETZM XXLINE
SETZM XXPAGE
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Last MARK on this page has been removed.
/]
XDEL4: MOVE D,MARKS+1(E) ;Close ranks
MOVEM D,MARKS(E)
JUMPE D,.+2
AOJA E,.-3
POPJ P,
;This routine reloads XXPAGE and XXLINE for the new page
XMPAGE: PUSH P,T
PUSH P,E
MOVEI E,0
SETZM XXPAGE
SETZM XXLINE
HLRZ T,MARKS(E)
CAMLE T,CURPAG
AOJA E,.-2
CAME T,CURPAG
JRST XMPAG2 ;No marks on this page
MOVEM E,XXPAGE ;Store index for first mark on this page
HRRZ T,MARKS(E)
MOVEM T,XXLINE ;Store the line number
XMPAG2: POP P,E
JRST POPTJ
;This code handles a single line deletion
XXSUB: PUSH P,T
MOVE T,XXLINE
CAMGE T,ARRL
JRST POPTJ ;To restore T and exit
MOVE TT,[-1]
JRST XXALL
;This code handles multiple line additions and deletions
XLALL: PUSH P,T
MOVE T,XXLINE
CAMGE T,ARRL
JRST POPTJ ;Restore T and exit as all marks are before ARRL
MOVE TT,-2(P) ;Get push'ed value
JRST XXALL
;This code handles a single line insertion
XXADD: PUSH P,T
MOVE T,XXLINE
CAMGE T,ARRL
JRST POPTJ ;To restore T and exit
MOVEI TT,1
;This code is entered from XXADD, XXSUB and XLALL.
XXALL: PUSH P,E
MOVE E,XXPAGE ;Get index of first line affected
SUB T,ARRL
JUMPL T,XMPAG2 ;We are through
ADD T,TT ;Note that TT may be negative
JUMPL T,XXALL6 ;To delete mark for attached or deleted line
ADDM TT,XXLINE ;XXLINE line was affected
JRST XXALL3 ;Now fix the line itself
XXALL2: SUB T,ARRL
JUMPL T,XMPAG2 ;We are through
ADD T,TT ;Note that TT may be negative
JUMPL T,XXALL6 ;To delete mark for attached or deleted line
XXALL3: ADDM TT,MARKS(E)
XXALL4: HLRZ T,MARKS+1(E)
CAME T,CURPAG
JRST XMPAG2 ;All fixed
HRRZ T,MARKS+1(E)
AOJA E,XXALL2
XXALL6: PUSH P,E ;Save E while flushing mark
HRRZ T,MARKS(E)
CAME T,XXLINE
JRST XXALL8 ;XXLINE referenced line was not it
HLRZ T,MARKS+1(E) ;Is there another mark on this page?
CAMN T,CURPAG
JRST XXALL7 ;There is.
SETZM XXPAGE
SETZM XXLINE ;There was not so zero XXLINE
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Last MARK on this page has been obliterated.
/]
JRST XXALL8
XXALL7: HRRZ T,MARKS+1(E)
MOVEM T,XXLINE ;Temporary fix but value will have to be changed
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Remember: marks on attached or deleted lines are obliterated.
/]
XXALL8: MOVE T,MARKS+1(E) ;Shuffle to close ranks
MOVEM T,MARKS(E)
SKIPLE T ;Ranks are closed
AOJA E,.-3
SKIPN E ;Was last mark destroyed?
OUTSTR [ASCIZ / There are no more marks.
/]
POP P,E ;Get value before the shuffle
SOJA E,XXALL4 ;Entry has been moved up, remember.
;This routine handles page mark insertions
XPADD: PUSH P,E
MOVEI E,0
JRST XPADD2
XPADD1: HLRZ T,MARKS(E)
ADDI T,1 ;Compensate for fact that CURPAG was upped 1 by insertion
CAMGE T,CURPAG
JRST XPADD4
XPADD2: CAME T,CURPAG ;Is it on the split page?
JRST XPADD3 ;No, so only page value needs to be changed
HRRZ T,MARKS(E) ;Now attend to line number
SUB T,XXARRL ;Where is it with respect to insertion
ADDI T,1 ;This should go before the pushj.
JUMPLE T,XPADD4 ;It was before so we are through
HRRM T,MARKS(E) ;Fix line number
XPADD3: MOVE T,[1,,0]
ADDM T,MARKS(E)
AOJA E,XPADD1 ;Safe because table terminates with -1
XPADD4: POP P,E
POPJ P,
;This routine handles page mark deletions
XPSUB: PUSH P,E
MOVEI E,0
JRST XPSUB2
XPSUB1: HLRZ T,MARKS(E)
SUBI T,1 ;Compensate for fact that CURPAG was decreased by deletion
CAMGE T,CURPAG
JRST XPADD4 ;The rest are OK.
XPSUB2: CAME T,CURPAG ;Is it on the ajoined portion?
JRST XPSUB3 ;No, so only page value needs to be changed
MOVE T,XXARRL ;Line number on ajoined portion needs to be increased
ADDM T,MARKS(E) ;Fix line number
XPSUB3: MOVN T,[1,,0]
ADDM T,MARKS(E)
AOJA E,XPSUB1 ;Safe because table terminates with -1
;DELLIN DELPOS
;DELLIN DELETES C(A) LINES AT THE POINTER
DELLIN: TRNN F,EDITM
JRST DELLI2
SOJN B,REEDIT ;FROM EDITOR AND NOT CTRL1
TDNE F,[PMLIN!OFFEND,,EDBRK] ;No funny business, please
JRST REEDIT ;(EDBRK can be on if he used an argument)
MOVEI A,1 ;Ignore argument to control-d
DELLI2: PUSH P,TOPWIN
MOVEM A,SAVARG# ;SAVE ARGUMENT TO SEE IF WE'RE FROM MSG
JUMPGE A,DELPOS
MOVNS A ;MINUS DELETE - BACK UP THE ARROW, THEN TREAT AS PLUS
AOJ A,
CAMLE A,ARRL ;NMVARR WILL MAKE THIS CHECK,
MOVE A,ARRL ;BUT WE SHOULD ALSO LIMIT OUR DELETE
SOJ A,
PUSH P,A
PUSHJ P,NMVARR
MOVN A,(P)
ADDM A,-1(P) ;ADJUST WINDOW BY AMOUNT FLUSHED
POP P,A
DELPOS: SETZM DELPGS#
MOVE B,LINES
SUB B,ARRL
CAILE A,1(B)
MOVEI A,1(B) ;LIMIT US TO WHAT WE'VE GOT
JUMPE A,CHKMS0 ;Maybe delete page even if no text there
PUSH P,[0]
TLO F,NOCHK
MOVE B,ARRLIN
HLRZ G,(B)
MOVE C,A
PUSH P,C
;DELLP DELL2 DELDSP DELPR DELPR1 DELPR2
DELLP: SKIPGE T,TXTFLG(B) ;Was SKIPGE T,1(B)
JRST DELPM ;Current line is page mark.
DELPR: TRNN F,EDITM
JRST DELPR2
HRRZ TT,(B) ;Pointer to next line.
SKIPL TXTFLG(TT) ;Was SKIPL 1(TT) ;Don't combine lines if next line is page mark
CAIN TT,BOTSTR ; or if it is line of asterisks at end of page
JRST DELPR1
HRRZ TT,-1(TT) ;Get words occupied by second line in core
SUBI TT,5 ;Extra words not occupied by text
IMULI TT,5 ;Convert to chars. (includes allowance for TAB's)
ADD TT,EDTBS ;TABS are not counted in EDPOS but equiv. spaces are
ADD TT,EDTBS ;so add EDTBS twice
ADD TT,EDPOS ;Add length of current line
SKIPN DPY ;Skip unless Imlac (shouldn't be here for TTY)
ADDI TT,EDCHRL+12-IMCHRL;Adjustment for smaller Imlac line editor
CAIG TT,EDCHRL+12 ;Allowance already made for TAB's in second line
JRST DELPR2 ;but allow room to split line with a β<cr>
SORRY Command aborted. Line would be too long.
SUB P,[3,,3]
JRST REEDT2 ;Don't say HUH
DELPR1: SUB P,[3,,3] ;Here if next line is OFFEND or PMLIN
JRST REEDIT ;Say HUH
DELPR2: TLNE T,WINBIT
SETZM WINLIN
HLRZ T,TXTCNT(B) ;Get char count as stored
MOVN T,T
ADDM T,CHARS
MOVEI A,(B)
HRRZ B,(B)
PUSHJ P,FSGIVE
SOJG C,DELLP
TLZ F,PMLIN!NOCHK
SKIPGE T,TXTFLG(B) ;Was SKIPGE T,1(B) ;Is the new line a page mark?
TLO F,PMLIN ;Yup
DELL2: HRRZM B,ARRLIN
HRRM B,(G)
HRLM G,(B)
MOVSI T,ARRBIT
IORB T,TXTFLG(B) ;Was IORB T,1(B)
HRRZ T,TXTCNT(B) ;New to permit splitting TXTCNT FROM TXTFLG
SKIPE T ;Is this a null line?
TLZA F,NULLIN ;Yes
TLO F,NULLIN
SUB C,(P)
SUB P,[1,,1]
ADDM C,LINES
PUSH P,C ;Arg for XLALL
SKIPLE XXLINE ;Are there marks on this page?
PUSHJ P,XLALL ;Fix up marks
POP P,C
POP P,T
SKIPE E,DELPGS
PUSHJ P,ADJPG
PUSHJ P,LINSET
PUSHJ P,SETWRT
POP P,A ;Old value of TOPWIN
PUSHJ P,SETWIN ;Recompute same window as before
TLO F,DSPTRL ;Force recalculation of trailer values
TRO F,DSPSCR+WRITE
TRNN F,EDITM ;Was this a control-d?
JRST CHKMSG ;No
PUSHJ P,UNINS ;Leave line insert mode if in it
;WHY? PUSHJ P,DISP ;FROM EDIT MODE - REDISPLAY NOW
;ME JFCL
PUSH P,EDCNM ;SET TO SPACE OUT TO OLD CURSOR POS
PUSH P,[240]
MOVE D,EDPNT
ADD D,[160000,,] ;BACK UP PNTR OVER CRLF
JUMPGE D,.+2
SUB D,[XOR 1]
MOVE B,EDPOS ;starting column for new line
MOVE A,ARRLIN ;new line (old line is in BUF)
HLRZ T,TXTCNT(A)
SUBI T,2 ; Not counting CRLF.
ADDM T,EDCNM ;Make new real character count for joined line.
MOVEI TT, ;LINED will count TABs in TT
MOVEI DSP,DELDSP-2 ;Our own table--see below
PUSHJ P,LINED ;Copy new line into BUF following old line
MOVEI T,(B) ;Total number of columns for line
PUSH P,T
ADD T,TT ;Plus twice the number of tabs from new part
ADD T,TT
ADD T,EDTTBS ;Plus twice the number of tabs from old part
ADD T,EDTTBS
PUSH P,D ;Save pointer to end of line in BUF
PUSHJ P,PUTBAK ;Replace new line with joined version
POP P,D
POP P,T ;Display length of line
PUSHJ P,EXTST ;Move following lines down if will wrap around on DD
JRST EDNUL ;Go edit combined line.
PUSHJ P,TELL0 ;Should never get here
PUSHJ P,TELL1 ; ditto
DELDSP: POPJ P, ;Just return upon seeing CR
PUSHJ P,TELL3 ;Shouldn't get here
AOJA TT,EDTAB ;Count a TAB and process it
;DELPM, DELPM1, DELPM2, DELPM3
DELPM: TRNE F,REDNLY+EDDIR
JRST [TLO F,PMLIN↔JRST DELL2]
LDB T,[221200,,LLDESC+LPMTXT+1(B)]
LDB TT,[341000,,LLDESC+LPMTXT+1(B)]
IMULI TT,200*5
ADDI TT,(T)
HRRZ A,LLDESC+LPMTXT+1(B) ;Get page number from mark being deleted
CAILE A,2 ;Skip if no FF was counted in deleted pagemark
SOS -1(P) ;Don't count the FF as moved to next pagemark
ADDM TT,-1(P) ;This many chars will be counted with next pagemark
MOVN TT,TT
ADDM TT,XCHRS ;Uncount chars and FF (if any) gone from non-final pages
SOJL T,.+2 ;Count the FF gone
SUBI T,200*5 ;Uncount the NULLS that are going away
ADDM T,CHARS
ADDM T,OCHRS ;KEEP RCOMP FROM HACKING
ADDM T,XCHRS ;Uncount the NULLS and FF from non-final pages
AOS XCHRS ;We uncounted the FF one too many times
MOVE T,LLDESC+LPMTXT(B) ;Get link word for pagemarks
TRNE T,-1
HLLM T,(T) ;Link back from next pagemark to prev one
TRNN T,-1
MOVEM T,XPLSTE
MOVS T,T
HLRM T,(T) ;Link forward from prev pagemark to next one
HLLM T,DELPGS ;Remember first pagemark beyond last one deleted
TRO F,UPDIR
HRRZ A,LLDESC+LPMTXT+1(B) ;Get page number of pagemark disappearing
SUB A,DELPGS ;Account for pages already partially deleted
PUSHJ P,DELPAG
AOS DELPGS ;Remember how many pages are being deleted
SOS XPAGES
MOVSI TT,DPBIT!D1BIT
ANDCAB TT,2(A)
TLNN TT,RPMASK
JRST [PUSHJ P,FSGIVE↔JRST DELPM3]
SKIPN T,DPLST
JRST [MOVEI T,DPLST↔HRLZM T,DPLST↔JRST DELPM2]
DELPM1: MOVE TT,2(T)
CAML TT,2(A)
JRST DELPM2
HRRZ T,(T)
CAIE T,DPLST
JRST DELPM1
DELPM2: HLL T,(T)
MOVEM T,(A) ;Put deleted page into list for returning FS later
HRLM A,(T)
MOVS T,T
HRRM A,(T)
DELPM3: MOVE T,TXTFLG(B) ;ALS missed this one too--Get line flags
JRST DELPR
;DELPAG, DELPG1, ADJPG, ADJPGL
DELPAG: PUSHJ P,FNDPAG ;Find dir entry for page being deleted
MOVEI A,(T)
DELPG1: MOVS T,(A) ;Get link word from dir entry
MOVSI TT,DPBIT
SKIPL 2(A)
JRST .+3
HRRZM T,DIRPT ;Deleting last page in core (CURPAG)--save ptr to prev page
IORM TT,2(T)
HLRM T,(T) ;Link forward around deleted entry
MOVS T,T
HLLM T,(T) ;Link backward around deleted entry
HRRZ T,2(A)
MOVNI T,=12(T)
ADDM T,DIRSIZ
SOS PAGES
SOS CURPAG
TRO F,UPDIR
TLO F,DSPTRL ;Force recalculation of trailer values
POPJ P,
;Get here after deleting one or more pagemarks to fix record & char counts
;in next pagemark, which is pointed to now by LH of E.
;T has count of chars formerly counted in the deleted pagemarks.
ADJPG: PUSH P,T
PUSHJ P,RDSPA4
PUSHJ P,DSHED
POP P,T
HLRZ G,E
JUMPE G,CPOPJ
LDB A,[341000,,1(G)] ;Old record count for pagemark
IMULI A,200*5
LDB TT,[221200,,1(G)] ;Old excess char count
ADDI T,(TT)
ADD T,A ;Now T has new total char count for this pagemark
JUMPE TT,ADJPG3
ADDI A,(TT)
SUBI TT,200*5
ADDM TT,XCHRS ;Uncount old NULLs everywhere
ADDM TT,CHARS
ADDM TT,OCHRS
ADJPG3: MOVN A,A
ADDM A,XCHRS ;Uncount old total chars for this pagemark
HRRZ A,1(G) ;Get page number (old) of this pagemark
CAIG A,2(E) ;Is there a FF on previous page?
SUBI T,1 ;No, but FF was previously counted in this pagemark
ADDM T,XCHRS ;Count new chars for this pagemark
IDIVI T,200*5
DPB TT,[221200,,1(G)] ;New number of excess chars
DPB T,[341000,,1(G)] ;New number of records for this pagemark
JUMPE TT,ADJPG2 ;Jump if no nulls here
SUBI TT,200*5
MOVN TT,TT
ADDM TT,XCHRS ;Count nulls needed for this pagemark
ADDM TT,CHARS
ADDM TT,OCHRS
ADJPG2: MOVNI E,(E)
ADJPGL: ADDM E,1(G) ;Reduce page number of all following pagemarks
HRRZ T,1(G)
MOVE A,[440700,,H]
MOVEI H,1
PUSHJ P,NUMSTR
MOVEM H,PMPAG-PMTXT-LPMTXT(G)
AOS T,TXTNUM
HRRM T,TXTSER-LLDESC-LPMTXT(G) ;Was HRRM T,2-LLDESC-LPMTXT(G)
HRRZ G,(G)
JUMPN G,ADJPGL
POPJ P,
;RCOMP, RCOMP1, RCOMP2, RCOMPX
;RCOMP is called only from SETWRT and then only when two or more pages are in core.
;This routine updates the number of records and chars now needed by the first
;pagemark following the arrow line, assuming all text changes were together.
RCOMP: HLRZ T,2(G)
CAML T,ARRL ;Find first pagemark beyond arrow line
JRST RCOMP1 ;That pagemark's preceding page has more chars in it
HRRZ G,(G)
JUMPN G,RCOMP
JRST RCOMPX
RCOMP1: MOVE T,CHARS
SUB T,OCHRS ;This gives us number of characters added to page
ADDM T,XCHRS ;XCHRS is number of chars+nulls before final pagemark
LDB H,[221200,,1(G)]
ADDI T,(H)
IDIVI T,200*5
JUMPL TT,[ADDI TT,200*5↔SOJA T,.+1] ;Make remainder char count positive.
DPB TT,[221200,,1(G)]
LSH T,12+22
ADDM T,1(G) ;Adjust number of records taken up by preceding page
JUMPE H,.+2
SUBI H,200*5 ;Negative of amt of room there used to be in page
JUMPE TT,.+2
SUBI TT,200*5 ;Negative of amt of room in page now
SUB H,TT ;Additional amount of room needed for new nulls
ADDM H,CHARS
ADDM H,XCHRS
MOVE T,LINES
SUB T,OLINES ;Number of lines added at arrow affects the line
HRLZS T ; number of each pagemark line below
RCOMP2: ADDM T,2(G)
HRRZ G,(G)
JUMPN G,RCOMP2
RCOMPX: MOVE T,CHARS
MOVEM T,OCHRS
MOVE T,LINES
MOVEM T,OLINES
POPJ P,
;DELETE, DELET1, ADDPAG
DELETE: MOVE A,LINES
MOVEM A,XXARRL ;Save line number at end of page in this case
MOVE A,CURPAG
AOJ A,
CAMLE A,PAGES
JRST PGERR
PUSH P,LINES
JSP B,ADDPAG
SOS CHARS ;-1 FF
POP P,T
MOVSI TT,ARRBIT!WINBIT
AND TT,BOTSTR+TXTFLG
ANDCAM TT,BOTSTR+TXTFLG ;Arrow could have been pointing at BOTSTR
IORB TT,TXTFLG(T) ;Was IORB TT,1(T)
TLNN TT,ARRBIT
JRST DELET1
PUSH P,TT
HRRZ TT,TXTCNT(T)
SKIPE TT ;Is this a null line?
TLZ F,NULLIN ;No
POP P,TT
HRRZM T,ARRLIN
DELET1: TLNE TT,WINBIT
HRRZM T,WINLIN
HLLM T,(T)
MOVS T,T
HLRM T,(T)
POP P,T
ADDB T,LINES
MOVEM T,OLINES# ;Make RCOMP think nothing happened
MOVE T,CHARS
MOVEM T,OCHRS#
MOVE A,CURPAG
PUSHJ P,DELPAG ;Unlink directory entry for page deleted
PUSHJ P,FSGIVE
PUSHJ P,LINSET
PUSHJ P,SETWRT
;This code is to be put in where one returns from a page mark deletion
; PUSH P,T
HLRZ T,MARKS
SUBI T,1
CAML T,CURPAG
PUSHJ P,XPSUB ;At least one mark needs attention
; PUSHJ P,RDSPA1 ;Now fix page numbers in the trailer
; PUSHJ P,DSTRL ;and make sure that the trailer is redisplayed
TLO F,DSPTRL ;Force recalculation of trailer values
; POP P,T
PUSHJ P,RDSPA4 ;Update page numbers on header line
PUSHJ P,DSHED ;Force header line to be redisplayed
JRST WRPAGE
ADDPAG: MOVE T,PAGE
HLL T,BOTSTR
PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
PUSH P,B
PUSHJ P,RDPAG0
HRRZ T,-1(P)
CAIN T,BOTSTR
MOVEI T,-1(P)
MOVEI TT,PAGE
HRLM TT,(T)
EXCH T,PAGE
HRRM T,-1(P)
TRO F,DSPSCR
POPJ P,
;APPEND, APPLUZ
APPEND: TRNE F,EDDIR!FILLUZ ;Can't do this on dir page or in non-formatted file
POPJ P,
APPEN1: PUSH P,A
MOVE A,CURPAG ;Actual number of last page in core
AOS T,A ;New page we want to add
CAMLE A,PAGES ;Is there such a page?
JRST PGERR1 ;Nope
SUB T,FIRPAG ;Number of pages in core now
MOVE TT,RELPGN ;Number of "real" (appended) pages already in core
CAIGE TT,RPMASK ;Max relative page number allowed
CAIL T,RPMASK
JRST APPLUZ ;No room for higher relatively-numbered pages in core
AOS XPAGES# ;Count another extra page in core
PUSH P,LINES
MOVE T,CHARS
PUSH P,T
IDIVI T,200*5
JUMPE TT,.+3
MOVN TT,TT
ADDI TT,200*5
PUSH P,TT
JSP B,ADDPAG ;Read in next page
HRLM P,(T) ;Make new page point back to new pagemark line (on stack)
MOVEI B,LLDESC+LPMTXT+2
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A) ;store FS flag for new pagemark line
POP P,T ;pointers back to end of old page, forw to new page
MOVEM T,(A) ;store line links in new pagemark line FS block
HRLM A,(T) ;make new page point back to new pagemark line
MOVS T,T
HRRM A,(T) ;make end of old page point forw to new pagemark line
POP P,E
ADDM E,CHARS ;count nulls needed to pad prev page to full record
POP P,T ;prev value of CHARS before new page read in
SUB T,XCHRS
ADD E,T
ADDM E,XCHRS#
IDIVI T,200*5
DPB T,[121000,,TT]
HRL TT,CURPAG
MOVSM TT,LLDESC+LPMTXT+1(A)
POP P,E ;prev value of LINES before nww page read in
AOJA E,APPEN2 ;count the new pagemark in total LINES
APPLUZ: SORRY Cannot have any more pages in core.
SUB P,[1,,1] ;Flush arg from stack
PUSHJ P,LINSE2 ;Fix up things in case we appended any pages
PUSHJ P,CLEARX ;See if X on top line should be turned off
JRST POPJ1
;APPEN2, PMTXT, PMPAG
APPEN2: ADDM E,LINES
HRLM E,LLDESC+LPMTXT+2(A)
MOVEI T,LLDESC+LPMTXT(A)
SKIPN D,XPLST
TROA D,XPLST#
HLRZ D,XPLSTE
HRLZM D,(T)
HRRM T,(D)
HRLZM T,XPLSTE#
MOVSI T,ARRBIT!WINBIT
AND T,BOTSTR+TXTFLG
ANDCAM T,BOTSTR+TXTFLG ;Remove bits if arrow was at BOTSTR
TLO T,PMARK
HLLM T,TXTFLG(A) ;Was MOVEM T,1(A)
SETZM TXTCNT(A)
TLNE T,ARRBIT
MOVEM A,ARRLIN
TLNE T,WINBIT
MOVEM A,WINLIN
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
ADD A,[PMTXT,,LLDESC]
MOVE B,A
BLT B,LPMTXT-1(A)
ADD A,[440700-PMTXT,,PMPAG-PMTXT]
MOVE T,CURPAG
PUSHJ P,NUMSTR
MOVE T,CHARS
MOVEM T,OCHRS#
MOVE T,LINES
MOVEM T,OLINES#
POP P,A
SOJG A,APPEN1
PUSHJ P,CLEARX ;See if X on top line should be off now
JRST LINSE2
PMTXT: ASCID/|||||||| PAGE /
PMPAG: 1
ASCID/ ||||||||
/
LPMTXT←←.-PMTXT
;INSERT INSER0
INSERT:
; PUSHJ P,NDIRCK ;Doesn't return if in /N mode
INSER0: MOVEI B,LLDESC+LPMTXT+2 ;MARK command enters here
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
MOVE T,ARRLIN
HLL T,(T)
MOVEM T,(A)
HRLM A,(T)
MOVSI TT,ARRBIT!WINBIT
AND TT,TXTFLG(T) ;Was AND TT,1(T)
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
TLO TT,PMARK
HLLM TT,TXTFLG(A) ;Was MOVEM TT,1(A)
SETZM TXTCNT(A)
MOVEM A,ARRLIN
TLNE TT,WINBIT
MOVEM A,WINLIN
MOVS T,T
HRRM A,(T)
HLLZS TXTSER(A) ;Was SETZM 2(A)
;Need TO SAVE left half of word when this is used for TXTFLG
ADD A,[PMTXT,,LLDESC]
MOVE B,A
BLT B,LPMTXT-1(A)
ADDI A,LPMTXT
AOS CHARS
AOS T,LINES
SKIPN G,XPLST ;This instruction went away for a while by mistake
SOJA T,INSER6
;INSER1 INSER2 INSER3 INSER4 INSER5 INSER9 INSE10
INSER1: HLRZ T,2(G)
CAML T,ARRL ;Look for first pagemark past line for new one
JRST [HLL G,(G)↔HRLM A,(G)↔JRST INSER2]
HRRZ G,(G)
JUMPN G,INSER1
MOVE G,XPLSTE ;Pointer to last pagemark in core (LH)
HRLZM A,XPLSTE ;Store new last pagemark in core
INSER2: HLRZ T,G ;Pointer to pagemark just before new one
CAIN T,XPLST
JRST INSER7 ;No pagemark before new one
HRRZ B,1(T) ;Number of page this new pagemark ends
HLRZ C,2(T)
INSER3: MOVEM G,(A)
HRRM A,(T)
MOVE TT,ARRL
HRLM TT,2(A) ;Store line number of new pagemark in its FS
HLRZ E,-LLDESC-LPMTXT(A) ;Get pointer to last line left on prev page
CAIG B,1 ;Skip unless prev page is page 1
TDZA D,D ;No FF on page 1
MOVSI D,1 ;Count FF as 1 char
SUB C,ARRL
AOJGE C,INSER5
INSER4: ADD D,TXTCNT(E) ;Assuming that right half will not overflow
HLRZ E,(E) ;Count chars on page before this pagemark
AOJL C,INSER4
INSER5: HLRZS D ;To right for processing
MOVN C,D ;Save char count of new pagemark
ADDM D,XCHRS
IDIVI D,200*5 ;Full-record count left in D, remainder in E
HRLI B,(E)
DPB D,[341000,,B]
MOVEM B,1(A) ;Store records, chars, page number for new pagemark.
JUMPE E,INSER9
MOVN E,E
ADDI E,200*5 ;Number of nulls needed for new pagemark
ADDM E,XCHRS
ADDM E,CHARS
INSER9: TRNN G,-1 ;Any following pagemark?
JRST INSER8 ;No
LDB T,[341000,,1(G)] ;Old record count of next pagemark
IMULI T,200*5
LDB TT,[221200,,1(G)] ;Old char count
JUMPE TT,INSE10
ADDI T,(TT) ;Old total chars
SUBI TT,200*5 ;Negative number of old nulls
ADDM TT,CHARS
ADDM TT,XCHRS
INSE10: ADDI C,1 ;Don't count the FF in C as moved to other page
ADDM C,XCHRS ;These real chars were already counted--uncount them
ADD T,C ;New number of chars on second pagemark
IDIVI T,200*5
DPB TT,[221200,,1(G)] ;New char count
DPB T,[341000,,1(G)] ;New record count
JUMPE TT,INSER8 ;Jump if no nulls now
MOVN TT,TT
ADDI TT,200*5 ;New number of nulls
ADDM TT,CHARS
ADDM TT,XCHRS
;INSER8, DIRADD
INSER8: MOVE E,CHARS
MOVEM E,OCHRS ;Make RCOMP think nothing has happened
AOS XPAGES
MOVEI E,1
MOVEI G,(A)
PUSHJ P,ADJPGL
MOVEI A,(B)
PUSHJ P,FNDPAG
PUSHJ P,DIRADD
MOVSI TT,DPBIT
AND TT,2(T)
ANDCAM TT,2(T)
JUMPE TT,.+2
HRRZM A,DIRPT
HLLM TT,2(A)
AOS CURPAG
TDO F,[PMLIN!NULLIN,,UPDIR!UPDTXT]
PUSHJ P,SETWRT
PUSHJ P,LINSET
PUSHJ P,RDSPA4 ;Update page numbers on header line
PUSHJ P,DSHED ;Force header to be redisplayed
MOVE B,ARRLIN
MOVE A,ARRL
HRLM A,LLDESC+LPMTXT+2(B) ;GOT AOSED BY RCOMP
AOJA A,SETARR
DIRADD: HRL T,(T)
MOVS T,T
DIRAD1: PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
MOVEI B,LPDESC+1
PUSHJ P,FSGET
MOVSI T,DIRCOD
HLLM T,-1(A)
POP P,T
MOVEM T,(A)
HRLM A,(T)
MOVS T,T
HRRM A,(T)
SETZM 1(A)
MOVEI TT,2
MOVEM TT,2(A)
MOVE TT,[BYTE (7)15,12,177]
MOVEM TT,LPDESC(A)
AOS PAGES
MOVEI TT,=12+2
ADDM TT,DIRSIZ
POPJ P,
;INSER6 INSER7 MARK NDIRCK
INSER6: MOVEM T,OLINES
HRLZM A,XPLSTE
MOVSI G,XPLST
MOVEI T,XPLST
INSER7: MOVE B,FIRPAG
MOVEI C,
JRST INSER3
REPEAT 0,<
NDIRCK: HRRZ T,EDFIL+4 ;See if we are in /N mode.
CAIE T,777777
POPJ P, ;Nope, all ok
SORRY Insertion of pagemarks in /N mode is not implemented.
SUB P,[1,,1] ;Return up a level
JRST POPJ1 ;Don't say OK
>;REPEAT 0
MARK:
; PUSHJ P,NDIRCK ;Doesn't return if in /N mode
TRZE F,ATTMOD
PUSHJ P,ATTEX ;Put down attach buffer, then insert pagemark
MOVE T,ARRL
MOVEM T,XXARRL ;Save original line number of marked line
PUSHJ P,INSER0 ;Insert pagemark
;This code is to be put in where one returns from a page mark insertion
PUSH P,T
HLRZ T,MARKS
ADDI T,1
CAML T,CURPAG
PUSHJ P,XPADD ;At least one mark needs attention
POP P,T
HRRZ A,LLDESC+LPMTXT+1(B)
JRST NEWPG0
;CONTQ
CONTQ: SKIPN IMLDPY ;This is illegal on TTYs
JRST ERR
HLRZ B,@ARRLIN
CAIE B,PAGE
SKIPGE 1(B)
POPJ P,
HRRZ B,-1(B)
SUBI B,2
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
HLRZ T,@ARRLIN
HRL T,ARRLIN
MOVSM T,(A)
HRRM A,(T)
HRLM A,@ARRLIN
MOVEM A,ARRLIN
AOS LINES
SKIPLE XXLINE ;Are there line marks on this page
PUSHJ P,XXADD ;Yes
MOVSI B,1(T)
HRRI B,1(A)
MOVE T,B
ADD B,-1(A)
BLT T,-1-1-2(B)
HLRZ T,TXTCNT(A)
ADDM T,CHARS
CAIG T,2
TLOA F,NULLIN
TLZA F,NULLIN!PMLIN
TLZ F,PMLIN
HRRZ B,(A)
MOVSI T,ARRBIT!WINBIT
AND T,TXTFLG(B) ;Was AND T,1(B)
TLNE T,WINBIT
MOVEM A,WINLIN
ANDCAM T,TXTFLG(B) ;Was ANDCAM T,1(B)
HLLM T,TXTFLG(A) ;Was HLLM T,1(A)
PUSHJ P,LINSET
PUSHJ P,SETWRT
TLNE F,NULLIN
POPJ P,
PUSH P,[0]
AOBJN P,EDIT1
PUSHJ P,TELLZ
;ATTACH, ATTCH1, ARGCHK, ARGCHN
PUSHJ P,ATTSRC
ATTACH: MOVEM A,SAVARG ;Save argument to tell if came from MSG
PUSHJ P,ATTDO
PUSHJ P,ATTEX
PUSHJ P,ATTCH1
HRLM G,(C)
HRRM C,(G)
MOVSI T,ARRBIT
IORB T,TXTFLG(C) ;Was IORB T,1(C)
HRRZ T,TXTCNT(C)
SKIPN T
TLOA F,NULLIN
TLZ F,NULLIN
MOVSI T,ARRBIT
EXCH C,ARRLIN
ANDCAM T,TXTFLG(C) ;Was ANDCAM T,1(C)
SKIPN WINLIN
SETOM BOTWIN
MOVN T,ATTSIZ
ADDM T,CHARS
MOVN T,ATTNUM
ADDM T,LINES
SKIPG XXLINE ;Are there marks on this page
JRST .+4
PUSH P,T
PUSHJ P,XLALL ;Fix up marks
POP P,T
PUSHJ P,LINSET
PUSHJ P,GPAGL
MOVEM T,ATTLOC#
MOVE T,ZINDEX ;Remember what file he attached the stuff in
MOVEM T,ATTFIL#
SETZM ATTPOS
PUSHJ P,SETWRT
JRST CHKMSG ;See if we now need to delete a page mark
ATTCH1: MOVEI A,(C)
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A)
PUSHJ P,TELLZ
TLZN T,WINBIT
POPJ P,
SETZM WINLIN
HLLM T,TXTFLG(A) ;Was MOVEM T,1(A)
POPJ P,
ARGCHK: JUMPLE A,ARGCHN
MOVE T,LINES
SUB T,ARRL
CAILE A,1(T)
MOVEI A,1(T)
POPJ P,
ARGCHN: JUMPE A,CPOPJ
MOVN A,A
MOVE T,ARRL
CAILE A,-1(T)
MOVEI A,-1(T)
PUSH P,A
PUSHJ P,NMVARR
JRST POPAJ
;ATTDO ATTDO0 ATTDO2 ATTDO1 ATTOK ATTCHK
ATTDO: TRNE F,REL
ADD A,ATTNUM
TRZE F,ATTMOD
XCT @(P)
ATTDO0: AOS (P)
PUSHJ P,ARGCHK
MOVEM A,ATTMOV#
SKIPG D,A
JRST POPAJ
SKIPE XPAGES
JRST ATTCHK
ATTOK: HLRZ G,@ARRLIN
MOVEM F,ATTFLG#
TRO F,ATTMOD
SETZM ATTSIZ
MOVEI E,ATTBUF
ATTDO2: HRRZ C,ARRLIN
ADDB A,ATTNUM
MOVEI T,(A)
CAILE T,ATTMAX
MOVEI T,ATTMAX
PUSHJ P,EXSET
ATTDO1: XCT @(P)
HRRM A,(E)
HRLM E,(A)
MOVEI E,(A)
; LDB T,[111100,,TXTCNT(A)] ;Was LDB T,[111100,,1(A)]
HLRZ T,TXTCNT(A)
ADDM T,ATTSIZ#
HRRZ C,(C)
SOJG D,ATTDO1
MOVEI A,ATTBUF
HRRM A,(E)
HRLM E,ATTBUF
JRST POPJ1
ATTCHK: PUSHJ P,GPAGL
HRL T,ARRL
PUSH P,T
ADDM A,ARRL
PUSHJ P,GPAGL
ANDI T,-1
POP P,TT
HLRZM TT,ARRL
CAIN T,(TT)
JRST [TLO F,DSPTRL↔JRST ATTOK] ;Force recalculation of trailer numbers
SUB P,[1,,1]
SORRY MULTI-PAGE ATTACH NOT IMPLEMENTED.
JRST POPJ1C
;ATTREP ATTEX ATTRE3 ATTRE4 ATTRE5 ATTRE6 ATTRE7 ATTRE8 ATTRE9
ATTREP: SKIPN A,ATTLOC ;ATTLOC=<line>,,<page> where attach buffer came from
JRST ATTKIL
SKIPGE T,ATTFIL
JRST ATTRE3 ;File index number has been re-used
CAME T,ZINDEX
JRST ATTRE4 ;Not currently in the file from which text came
PUSH P,A
ANDI A,-1
CAMG A,CURPAG ;Is original page in core?
CAMGE A,FIRPAG
PUSHJ P,NEWPG0 ;No, read it in now
JRST ATTRE5 ;Ok, got right page
ATTRE9: MOVEI A,-1 ;Got wrong page read in, go to end of page
ATTRE6: SUB P,[1,,1] ;Flush ATTLOC from stack
PUSHJ P,SETARR ;Get to edge of closest page
SORRY Cannot find page from which attach buffer came.
JRST POPJ1
ATTRE3: SORRY <Attach buffer came from different file and that file's
number in the file list has been re-assigned.>
JRST POPJ1
ATTRE4: SORRY Attach buffer came from different file:
OUTSTR [ASCIZ/ #/]
IDIVI T,ZENT ;Get real file number
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/
/]
JRST POPJ1
ATTRE5: TRZN F,ATTMOD ;Here with correct page in core
PUSHJ P,TELLZ
HRRZ A,(P) ;Get back page number
SUB A,FIRPAG ;Figure relative page number of in-core pages
JUMPL A,ATTRE6 ;Huh? This should never happen, but just in case
JUMPE A,ATTRE7
MOVEI G,XPLST
ATTRE8: HRRZ G,(G) ;Pointer to next pagemark
JUMPE G,ATTRE9 ;Oops again
SOJG A,ATTRE8
HLRZ A,2(G) ;line number of pagemark
ATTRE7: POP P,TT
HLRZ TT,TT ;Line number where buffer came from
ADDI A,(TT)
PUSHJ P,SETARR
ATTEX: PUSHJ P,EXCLR
MOVEI T,
EXCH T,ATTNUM
ADDM T,LINES
SKIPG XXLINE ;Are there marks on this page
JRST .+4
PUSH P,T
PUSHJ P,XLALL ;Fix up marks
POP P,T
MOVE T,ATTSIZ
ADDM T,CHARS
MOVS T,ATTBUF
MOVE TT,ARRLIN
HLL TT,(TT)
HRLM T,(TT)
HRRM TT,(T)
MOVS T,T
MOVS TT,TT
HRRM T,(TT)
HRLM TT,(T)
ANDI T,-1
MOVSI TT,ARRBIT
IORB TT,TXTFLG(T) ;Was IORB TT,1(T)
HRRZ TT,TXTCNT(T) ;Needed when TXTFLG differs from TXTCNT
SKIPN T ;Is this a null line?
TLOA F,NULLIN ;Yes
TLZ F,NULLIN
MOVSI TT,ARRBIT
EXCH T,ARRLIN
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
PUSHJ P,LINSET
MOVEI B,
EXCH B,ATTLOC
SETZM ATTPOS
PUSHJ P,GPAGL
MOVE TT,ATTFLG
CAMN T,B
TRNE TT,WRITE
JRST SETWRT
TRNE F,WRITE
PUSH P,[CLRWRT]
JRST SETWRT
;ATTKIL, ATTKL, ATTSRC, GPAGL, GPAGL0, GPAGL1, GPAGL2, GPAGL3, ATTWRT
ATTKIL: TRZN F,ATTMOD
JRST ERR
PUSHJ P,EXCLR
MOVE C,ATTNUM
HRRZ A,ATTBUF
TLO F,NOCHK
ATTKL: HRRZ B,(A)
PUSHJ P,FSGIVE
MOVEI A,(B)
SOJG C,ATTKL
TLZ F,NOCHK
PUSHJ P,CORCHK
SETZM ATTLOC
SETZM ATTPOS
SETZM ATTNUM
POPJ P,
ATTSRC: TRNE F,ARG
TRNE F,REL
JUMPGE A,[AOJA A,CPOPJ]
POPJ P,
;Routine to return <line>,,<page> in T for current line, even in multipage mode
GPAGL: SKIPE TT,XPLST
JRST GPAGL1
GPAGL0: MOVE T,FIRPAG
HRL T,ARRL
POPJ P,
GPAGL1: HLRZ T,2(TT)
CAML T,ARRL
JRST GPAGL0
GPAGL2: HLRZ T,2(TT)
CAML T,ARRL
JRST GPAGL3
HRRZ TT,(TT)
JUMPN TT,GPAGL2
MOVEI TT,XPLSTE
GPAGL3: HLRZ TT,(TT)
HRLO T,ARRL ;-1 in RH makes sure RH of 2(TT) doesn't borrow from LH of T
SUB T,2(TT)
HRR T,1(TT) ;Get real page number in RH
POPJ P,
ATTWRT: MOVEI T,WRITE
IORM T,ATTFLG
TRO F,DSPSCR
POPJ P,
;ATTCOP, ATTCP1, ATTCP
PUSHJ P,ATTSRC
ATTCOP: MOVSI T,ATTBUF
TRNN F,ATTMOD
MOVEM T,ATTBUF
PUSHJ P,ATTDO
JRST ATTCP
PUSHJ P,ATTCP1
SKIPE A,ATTMOV
PUSHJ P,MOVARR
SKIPE T,ATTMOV
PUSHJ P,GPAGL
MOVEM T,ATTPOS#
POPJ P,
ATTCP1: SUBI C,1
MOVEM C,FSBLK
HRRZ B,(C)
SUBI B,2
PUSHJ P,FSGET
AOS C,FSBLK
MOVSI TT,-1(C)
HRRI TT,-1(A)
BLT TT,-1(T)
MOVSI TT,ARRBIT!WINBIT
ANDCAM TT,TXTFLG(A) ;Was ANDCAM TT,1(A)
HLRZ E,ATTBUF
HRLM A,ATTBUF
MOVEI T,ATTBUF
MOVEM T,(A)
POPJ P,
ATTCP: TRNE F,REL
JRST ATTCP0
TRNN F,ARG
MOVE A,ATTNUM
PUSHJ P,ATTEX
JRST ATTCP3
;ATTCP0, ATTCPL, ATCMOR, ATTCP2, ATTCP3, GPAGL
ATTCP0: TRO F,ATTMOD!DSPSCR ;In attach mode and need to update screen
JUMPLE A,ATTCP2 ;Jump if we want no lines to be in attach buffer.
CAMN A,ATTNUM
JRST POPAJ
AOS (P)
CAML A,ATTNUM
JRST ATCMOR
MOVEI T,(A)
CAILE T,ATTMAX
MOVEI T,ATTMAX
PUSHJ P,EXSET
SUB A,ATTNUM
ADDM A,ATTNUM
PUSHJ P,GPAGL
CAMN T,ATTPOS
SKIPA T,A
MOVEI T,
MOVEM T,ATTMOV
JUMPGE A,POPJ1
MOVN C,A
MOVEI B,ATTBUF
ATTCPL: HLRZ A,ATTBUF
HLRZ T,(A)
HRRM B,(T)
HRLM T,ATTBUF
HLRZ T,TXTCNT(A)
MOVN T,T
ADDM T,ATTSIZ
PUSHJ P,FSGIVE
SOJG C,ATTCPL
JRST POPJ1
ATCMOR: SUB A,ATTNUM
PUSHJ P,ARGCHK
SKIPG D,A
JRST POPAJ
MOVEM A,ATTMOV
JRST ATTDO2
;Here when -#C given with # or less lines in attach buffer.
ATTCP2: PUSHJ P,ATTKIL ;Kill everything in attach buffer.
MOVEI A,0 ;Don't attach anything new now.
ATTCP3: MOVSI T,ATTBUF ;Attach buffer is now empty.
MOVEM T,ATTBUF
JRST ATTDO0
;EDIT EDIT1 LINED LINL1 EDDSP EDARG EDARGX ZLINE
;HERE IS WHERE WE GIVE THE CURRENT LINE TO THE LINE EDITOR
;AND LET THE SYSTEM WORRY ABOUT IT
ZLINE: SKIPN IMLACL
JRST ERR ;Z command is only legal on imlac
TRNE F,ARG!REL ;If any argument,
PUSHJ P,GOLINE ; then move to specified absolute line first
PUSH P,[0]
PUSH P,[0]
JRST EDIT1 ;Edit current line
EDIT: PUSH P,A ;SAVE REPEAT COUNT
DPB B,[70200,,C] ;GET BACK CONTROL BITS
PUSH P,C ;SAVE CHAR
EDIT1: MOVE D,[440700,,BUF] ;PLACE TO COPY TEXT TO
TLNE F,OFFEND+PMLIN
JRST EDNUL ;TRYING TO EDIT AT BOTTOM OF PAGE - EXTEND IT
MOVE A,ARRLIN
HRRZ T,-1(A) ;Words of characters as expanded (for displays)
HLRZ TT,TXTCNT(A)
XCT LEDTST ;See if too long for line editor
JRST EDFULL ;Too long
HRRZ T,TXTCNT(A)
MOVEI B, ;B will count display position for TABs
MOVEI DSP,EDDSP-2
PUSHJ P,EXTST ;If wrap around on DD (check T), move display down.
LINED: ADD A,[440700,,LLDESC]
TLNE F,NULLIN
HRLI A,350700 ;Skip the space in empty lines.
MOVSI E,LSPC
LINL1: ILDB C,A ;Copy text into BUF (mainly to fix tabs)
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,D
AOJA B,LINL1
PUSHJ P,TELL0 ;We should never get here
PUSHJ P,TELL1 ; ditto
EDDSP: JRST EDCR ;DONE WITH LINE
PUSHJ P,TELL3
JRST EDTAB ;TAB - SKIP EXTRA SPACES
PUSHJ P,TELL5
PUSHJ P,TELL6
EDARG: IDIVI A,=10
MOVEI T,200+"0"(B)
JUMPE A,EDARGX
IDIVI A,=10
HRROI A,200+"0"(A)
TRNE A,17
IDPB A,D
ADDI B,200+"0"
IDPB B,D
EDARGX: IDPB T,D
POPJ P,
;EDFULL, EDTAB, EDNUL, EDCR, AGAIN, EDRP1, EDRPT
EDFULL: SORRY Line too long for Line Editor.
SUB P,[2,,2]
JRST POPJ1C
EDTAB: IDPB C,D ;COPY THE TAB
ILDB C,A
CAIE C,11 ;Skip to second tab
JRST .-2
TRO B,7 ;Adjust count to position before next tab column
AOJA B,LINL1
EDNUL: MOVEI C,15
EDCR: IDPB C,D ;END OF LINE - STORE CR
MOVEI C,12
IDPB C,D ;AND LF
MOVEI C,
IDPB C,D ;AND NULL
AGAIN: TLNE D,760000
JRST .-2 ;GET TO WORD BOUNDARY
ADD D,[430200,,1] ;SET TO NEXT WORD - MAKE IT 9 BITS
HRRZM D,PTPNT ;SAVE PNTR FOR LATER
XCT LEPREP ;DO LEYPOS NOW ON DD (SO PTLOAD WILL MAKE CORRECT TABS)
SKIPN A,EDMOV# ;Do we want to position the cursor out in the line somewhere ?
JRST EDRP0 ;No.
SETZM EDMOV
PUSHJ P,EDARG
MOVEI C,240 ;α<space>
IDPB C,D
EDRP0: POP P,C ;GET CHAR
POP P,A ;& # TIMES TO PUT IT IN
CAILE A,=200
MOVEI A,=200 ;LET'S NOT BE RIDICULOUS
JUMPLE A,[SETZ C,↔JRST EDGL] ;DON'T STORE IF NONE and don't confuse MACLIN
TRNE C,200 ;If a ctrl chr.,
PUSHJ P,EDARG ; store the repeat arg.
EDRPT: CAILE A,=99
MOVEI A,=99
IDPB C,D
SOJG A,.-1 ;STORE IT N TIMES (If we have just been to EDARG, A≤0.)
;EDGL EDGL1 EDGL2 EDGL2A EDGL2B EDGBSL IMLPTL
;HERE WE GIVE THE TEXT TO THE SYSTEM, FOLLOWED BY N COPIES OF THE INITIAL CHAR
EDGL: SKIPLE QCHR# ;Set to 1 if an edit form of substitution command given
PUSHJ P,BSLXCT ;Do line-editor substitution. 377 in C won't confuse MACLIN
SKIPE MACPNT ;Macro expansion in progress?
PUSHJ P,MACLIN ;Yes, get everything up to first activator.
EDGL1: MOVEI C,0
IDPB C,D ;MAKE SURE 9-BIT STRING ENDS WITH NULL
TRO F,EDITM
SKIPN MACPNT
PUSHJ P,ABCRLF ;Make echo of line start at left margin.
SKIPE MACPNT
PTJOBX [0↔3] ;Turn off echoing of macro-edited stuff.
SKIPN DPY ;Don't do PTL7W9 for TTYs, maybe not for Imlacs
PUSHJ P,IMLPTL ;TTY or Imlac
PTL7W9 PT79 ;LOAD LINE EDITOR AND PASS ALONG SIMULATED "TYPE AHEAD"
SKIPE MACPNT
PTJOBX [0↔4] ;Turn echoing back on.
PUSHJ P,DISP ;Update display.
XCT LINTST
PUSHJ P,BEEPCK ;See if we need to beep him.
MOVSI E,LSPC
MOVEI DSP,EDGDSP-2
SETZB B,TT
SETZB T,EDCHR ;T WILL COUNT CHARACTERS READ FROM LINE EDITOR
MOVE D,[440700,,BUF] ;WHERE TO STORE AS WE GOBBLE IT BACK
TRO F,DSPSCR
TRZ F,EDBRK
EDGL2: INCHWL C ;READ CHAR
EDGL2B: TRNE C,600
JRST EDACT ;ANYTHING WITH BUCKY BITS IS AN ACTIVATOR
TDNE E,CTAB(C)
XCT @CTAB(C) ;AS WELL AS SELECTED OTHER CHARS
EDGL2A: IDPB C,D
AOJ B,
AOJA T,EDGL2 ;COUNT CHARACTER
IMLPTL: TRO F,DSPSCR ;Force display of line number
PUSHJ P,DISP
JFCL ;Always do it
SKIPE IMLACL ;Don't do PTL7W9 or CLRBFI for non-imlac TTYs
TLNE F,LINSM ;Don't do PTL7W9 or CLRBFI for Imlac in line insert mode
AOSA (P)
CLRBFI
POPJ P,
;EDGL3 EDGL4 REEDIT REEDT2 EDTMOR EDGDSP EDTAB2 PTOUT PTPNT EDLF ALTCHK ALTFIX
;HERE WE HAVE FINISHED THE LINE AND NOW HAVE TO DISPATCH ON THE ACTIVATION CHAR
EDGL3: MOVEM T,EDSIZ# ;REMEMBER NUMBER OF CHARS IN LINE
MOVEI C,15 ;TERMINATE IT IN CASE WE HAVE TO RE-EDIT
IDPB C,D
MOVEI A, ;AC A holds the command argument for CMDEX below
IDPB A,D
MOVEM D,EDPNT#
MOVEM B,EDCOLS# ;SAVE TOTAL DPY COLUMNS
MOVEM TT,EDTTBS#;& # TABS
PUSHJ P,EXCLR ;Clear extra DD line used by line editor.
TRZ F,ARG+REL+NEG+EDITM
HRRZ C,EDCHR ;HERE WE GO THROUGH THE COMMAND DISPATCH PROCEDURE
HRROI DSP,CMDSP
PUSHJ P,BEEPST ;Remember when we started processing command.
PUSHJ P,CMDEX ;Get dispatch word for command in D
JRST ALTCHK
TRO F,EDITM ;FLAG THAT WE CAME FROM LINE EDIT
TLNE D,NOEDIT ;OR IF WE SHOULD GO TO THIS COMMAND IMMEDIATELY
JRST [ TLNN D,DOEDIT ;Want to dispatch and return here?
JRST (D) ;No. Just go.
PUSHJ P,(D) ;Yes, execute routine and return.
OUTSTR [ASCIZ /
OK /] ;Command cannot have been CR, so output CRLF
JRST REEDT2
JRST REEDT2] ;Should never take double skip return, I hope!!!
TLNE D,DOEDIT
JRST EDITIT ;THIS ONE WANTS TO COMPLETE THE EDIT FIRST
REEDIT: OUTSTR [ASCIZ / ?HUH?/]
PUSHJ P,MACSTP ;Terminate macro expansion.
REEDT2: PUSH P,EDCNM ;WE DON'T LIKE THIS - EDIT IT AGAIN AT THE SAME CURSOR POS
EDTMR2: PUSH P,[240] ;THIS SHOULD GET US THERE
EDTMOR: MOVEI C, ;IN CASE WE NEED NULLS
MOVE T,EDCOLS
PUSHJ P,EXTST
MOVE D,EDPNT
JRST AGAIN
EDLF: SKIPN DPY
JRST EDLF2 ;Turn into CR on TTY
JRST EDACT2
EDTAB2: SKIPGE EDTABP
MOVEM B,EDTABP# ;REMEMBER POS OF FIRST TAB FOR REPRST
TRO B,7 ;DIDDLE COL POS
AOJA TT,EDGL2A ;& COUNT TABS
ALTFIX: MOVE T,ARRL
SUB T,TOPWIN
ADD T,SCRTOP ;Figure out screen line number of line edited
JUMPLE T,.+2
HLLZS DPYTAB+1(T) ;Force line edited to be redrawn
POPJ P,
ALTCHK: TLNE D,10000 ;Was user mode bit set by JSP D,CPOPJ or JSP D,ERRX?
JRST REEDIT ;Yes, error.
OUTSTR [ASCIZ/
/]
SKIPE IMLACL ;If on imlac, altmode may have occurred in middle of line
CLRBFI ;So flush rest of line
TLZN F,LINSM
JRST ALTFIX
MOVEI T,"→"
DPB T,[10700,,ARRON]
AOS T,EDCNM ;WE HAVE JUST LEFT LINE INSERT MODE
CAMN T,EDSIZ ;DID ALTMODE COME AT END OF LINE?
SOJG T,REPLIN ;YES, KEEP TEXT OF THAT LINE UNLESS EMPTY LINE
MOVEI A,1 ;NO, DELETE ONE LINE
TRZ F,EDITM
PUSHJ P,DELLIN
SKIPE NLININ ;WERE ANY LINES ACTUALLY INSERTED
POPJ P, ;YES
MOVE T,FSAV
TRNN T,WRITE
JRST CLRWRT
POPJ P,
AOJA C,EDACT2 ;BS. Make it a 200, ie, an illegal command
EDGDSP: JRST EDCR2 ;SPECIAL THINGS FOR CR
JRST EDLF ;LF
JRST EDTAB2 ;TAB
JRST EDGL2 ;FF
JRST EDACT2 ;ALTMODE
IMPURE
PT79: 0
B∀D
PTPJD: 0
PURE
;EDCR2, EDACT, EDACT2, EDITIT, REPLIN, PUTBAK, UNINS, FNEDIT, EDLF2
EDCR2: INCHRS C ;GET LF (CR'S ALWAYS HAVE LF'S)
PUSHJ P,TELLZ ;GLEEP?
EDLF2: MOVEM T,EDCNM ;Save number of chars before activator
TDC C,[-1,,15≠12] ;MAKE IT A CR (WITH BITS FROM LF)
AOJA T,EDACT1 ;Count CR. LF will be counted below.
EDACT: CAIE C,400 ;END OF LINE?
JRST EDACT2 ;NO
SKIPE EDCHR ;Seen an activation character yet?
JRST EDGL3
SORRY <
Line editor has filled up and activated. No more text can be added to this line.
Please type activation character you want.>
MOVEM T,EDCNM ;No, pretend activator came here and discard subsequent text
MOVEM B,EDPOS ; except for actual activation character
MOVEM TT,EDTBS
EDACT4: INCHWL C
TRNE C,600 ;Any control bits means its an activation char
JRST EDACT3 ;Got it
CAIN C,15 ;CR
JRST EDACT5 ;Go get bits from LF
CAIE C,175 ;Altmode
CAIN C,12 ;LF
JRST EDACT6
JRST EDACT4 ;Nothing special here
EDACT5: INCHRS C ;Get the LF that must follow a CR
PUSHJ P,TELLZ
TDC C,[-1,,15≠12] ;Turn the LF into a CR with same control bits
AOJA T,EDACT6 ;Count the CR
EDACT3: CAIN C,400 ;Is it really an activator this time?
JRST EDACT4 ;No, go back for more
EDACT6: MOVEM C,EDCHR ;Save activation character
INCHWL C
CAIE C,400 ;We have the activator, now skip to the 400 at end of line
JRST .-2
AOJA T,EDGL3 ;Done with line at last (Count the activator)
EDACT2: MOVEM T,EDCNM# ;Chr. position.
EDACT1: MOVEM B,EDPOS# ;SAVE ALL KINDS OF CRAP ABOUT IT - B has horiz. position.
MOVEM C,EDCHR# ;Chr.
MOVEM TT,EDTBS# ;No. of tabs before it.
SKIPN DPY ;Skip unless on TTY
AOJA T,EDGL3 ;Must be end of line from TTY
INCHRW C ;GET NEXT CHAR
CAIN C,400 ;END OF LINE?
AOJA T,EDGL3 ;yes
TRO F,EDBRK ;NOPE - FLAG IT AS A BROKEN LINE
SETOM EDTABP ;PREPARE TO LOCATE TAB
AOJA T,EDGL2B ;AND GET MORE
EDITIT: OUTSTR [ASCIZ /
/]
PUSH P,D ;Will POPJ to dispatch
FNEDIT: PUSH P,C
PUSH P,B
PUSH P,A
PUSH P,EDCNM ;Save location of activator in line
PUSHJ P,REPLIN
POP P,EDCNM
POP P,A
POP P,B
POP P,C
UNINS: TLZN F,LINSM
POPJ P,
MOVEI T,"→" ;WE HAVE JUST LEFT LINE INSERT MODE
DPB T,[10700,,ARRON]
POPJ P,
REPLIN: SKIPGE EDCHR ;HERE WE REPLACE THE CURRENT LINE TEXT WITH THE EDITED VERSION
SOS EDSIZ ;FUDGE FOR LF (IF PRESENT)
SOS T,EDSIZ ;AS WELL AS FOR ACTIVATION CHAR
MOVEM T,EDCNM ;A RANDOM PLACE TO SAVE IT
MOVE T,EDTTBS
LSH T,1
ADD T,EDCOLS ;# COLS + 2 * # TABS = TOTAL # CHARS WITH EXPANDED TABS
PUTBAK: PUSHJ P,EDPUT ;COPY THE TEXT (SHUFFLES ASSUMING C(T) CHARS)
SKIPN EDCNM
JRST [ MOVEI C,40 ;EMPTY LINE - PUT IN A SPACE FOR DD
IDPB C,A
JRST .+1]
FOR X IN(15,12) ;TERMINATE IT
{ MOVEI C,X
IDPB C,A
} TDZA C,C
IDPB C,A
TLNE A,760000
JRST .-2 ;FLUSH ANY GARBAGE IN THE REST OF THE WORD
MOVE T,EDCNM ;# CHARS
ADDI T,2 ;ACCOUNT FOR CRLF
HRL TT,T
HLRZ C,TXTCNT(D)
SUB T,C
ADDM T,CHARS ;UPDATE COUNT BY DIFFERENCE
MOVEM TT,TXTCNT(D)
TLZE F,TF1 ;Has anything been changed?
JRST SETWRT ;Yes
POPJ P, ;No
;EDPUT, EDPLR
;EDPUT ADJUSTS BUFFER TO TAKE C(T)+3 (CR-LF-NUL) CHARS INSTEAD OF THE CURRENT LINE,
;THEN COPIES C(EDCNM) CHARS FROM BUF, EXPANDING TABS
EDPUT: ADDI T,4+2+5*LLDESC ;<ROUND UP>+<CR-LF>+<EXTRA WDS>
IDIVI T,5 ;# WDS
TLNE F,OFFEND+PMLIN
JRST EDPLUZ ;OOPS - IT'S A PHONY LINE
EDPLR: MOVE A,ARRLIN
HRRZ B,-1(A) ;OLD # WDS
CAIN T,-2(B)
JRST EDPS
CAIL T,-2(B)
TLO F,NOCHK
MOVE B,T
PUSH P,TXTFLG(A)↔PUSH P,TXTCNT(A) ;WAS PUSH P,1(A)
MOVE T,(A)
PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
PUSHJ P,FSGIVE
TLZ F,NOCHK
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
MOVEM A,ARRLIN
POP P,T
MOVEM T,(A)
HRLM A,(T)
MOVS T,T
HRRM A,(T)
POP P,T
MOVEM T,TXTCNT(A)↔POP P,T↔HLLM T,TXTFLG(A) ;Was MOVEM T,1(A)
TLNE T,WINBIT
MOVEM A,WINLIN
SETOM LLDESC(A)
CAIG B,LLDESC+1
JRST EDPS
MOVSI T,LLDESC(A)
HRRI T,LLDESC+1(A)
ADDI B,(A)
BLT T,-1(B)
;FALLS THRU
;EDPS, EDPL, EDPLUZ
EDPS: TLZ F,TF1 ;Used to detect if anything changed on the line
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
MOVEI D,(A)
ADD A,[440700,,LLDESC]
MOVE B,[440700,,BUF]
MOVEI TT,
SKIPN T,EDCNM
JRST [ TLON F,NULLIN ;The new line is empty.
TLO F,TF1 ;But the old one wasn't.
POPJ P,]
TLZE F,NULLIN
TLO F,TF1 ;Was empty but isn't now, so must be different
EDPL: ILDB C,B
TLNN F,TF1 ;Has line already been different?
JRST [ILDB Q,A ;No
CAMN C,Q ;Has character changed?
JRST EDPL1 ;No, so do not bother to store it
DPB C,A ;Change it and
TLO F,TF1 ; set flag to remember line has changed
JRST EDPL1]
IDPB C,A
EDPL1: CAIE C,11 ;THE ONLY THING WE WORRY ABOUT
AOJA TT,EDPL2
MOVEI C,40 ;TAB - APPEND SOME SPACES
HRLS TT
TLO TT,-10
IDPB C,A
AOBJN TT,.-1
MOVEI C,11
IDPB C,A
EDPL2: SOJG T,EDPL
MOVE Q,A ;Copy byte pointer so we won't destroy it.
ILDB C,Q
CAIE C,15 ;Does old line end here?
TLO F,TF1 ;No, lines are different
POPJ P,
EDPLUZ: PUSH P,T ;HERE AFTER EDITING LINE N+1 (PHONY NULL LINE MADE AT EDNUL)
PUSHJ P,INSONA ;MAKE A REAL LINE
POP P,T ;RESTORE # WORDS
JRST EDPLR
;EDSNK
;EDSNK: JRST EDGBSL ;Now go to line editor reading routine
;CRDSP REGCR REGCR1 REGCR2
;FOR CR WE DISPATCH ON CONTROL BITS
CRDSP: NOEDIT!SACMD!SSCMD,,REGCR
DOEDIT!NOATT!SSCMD,,CONTCR
NOEDIT!NOATT,,METACR
NOEDIT!NOATT,,DUBLCR
TLO F,OKF
REGCR: TRNN F,EDITM ;Regular CR - No bucky bits
JRST REGCR1 ;Just move arrow.
TRNE F,REL!ARG ;If any argument, pretend CR came at end of line
TRZ F,EDBRK
PUSHJ P,LECR ;See if CR came in middle of line being edited.
JRST REGCR2 ;No, just move arrow
PUSH P,D
PUSHJ P,REPRST
POP P,D
PUSH P,[1]
PUSH P,[311] ;SET UP INSERT MODE FOR NEW LINE
JRST EDTMOR
REGCR1: MOVE B,ARRL
CAMLE B,LINES
JUMPGE A,CPOPJ ;Don't let plain CR at end of page create new line anymore.
AOS (P)
REGCR2: TRNE F,ATTMOD
JRST MOVARR ;Move arrow to new line in attach mode
MOVE B,ARRL ;HERE WE'RE JUST MOVING - SEE WHERE TO
CAMLE B,LINES
JUMPG A,INSONE ;GOING OFF THE BOTTOM - ADD A LINE
JRST MOVARR ;Move arrow to new line
;CONTCR, CNTCR2, METACR, REPRST, REPRS2, METAC2
PUSHJ P,CNTCR2
CONTCR: TRNE F,EDITM
POPJ P,
SKIPGE A,SRCOFF
JRST POPJ1C ;No search string found
HRRZM A,EDMOV
MOVEI A,
JRST EDIT
CNTCR2: MOVE D,[EDOK*10,,EDIT]
MOVEI A,
POPJ P,
METAC2: PUSHJ P,LECR ;TAKE APPROPRIATE ACTION
JRST REGCR2 ;Not in middle of line, just move down a line
PUSH P,D
PUSHJ P,REPRST
POP P,D
PUSH P,[0] ;No special type-ahead needed.
JRST EDTMR2
METAC3: MOVEI A,1
PUSHJ P,MOVARR ;Down a line so that we will be pointing to new empty line
JRST INSONA ;Insert new empty line
METACR: TLNE F,LINSM
JRST METAC2 ;In line insert mode: keep second half of line in line editor
TRNN F,EDITM
JRST INSONE ;Not from editor, just add blank line above current one.
PUSHJ P,LECR ;DO LINE EDIT STUFF IF NECESSARY
JRST METAC3 ;NOT MIDDLE OF LINE - JUST ADD BLANK LINE
REPRST: MOVN T,EDCNM ;HERE WE STORE THE REST OF THE LINE AFTER THE ACTIVATOR
ADDM T,EDSIZ ;BY UPDATING ALL THE PARAMS BY THE AMOUNT ALREADY DONE
AOSG T,EDTABP
JRST REPRS2
SOS TT,T ;HERE WE FUDGE FOR THE TAB WHOSE POSITION
SUB TT,EDPOS ;(AND HENCE SIZE) IS CHANGING (SIGH)
ORCMI T,7
ORCMI TT,7
SUB T,TT
REPRS2: SUB T,EDPOS
ADDM T,EDCOLS
MOVN T,EDTBS
ADDM T,EDTTBS
JRST REPLIN
;LECR DUBLCR DUBCR1 DUBCR2 DUBCR3 DUBCR4
;HERE WE HANDLE ALL FLAVORS OF CR FROM THE LINE EDITOR
;IF IT'S AT THE END WE JUST REPLACE THE TEXT AND RETURN
;IF IT'S IN THE MIDDLE WE REPLACE UP TO THE BREAK, MAKE A NEW LINE,
;MOVE THE REMAINING TEXT DOWN IN BUF, AND SKIP RETURN
LECR: PUSH P,A ;Save argument to command
TRNN F,EDBRK ;MIDDLE OF LINE?
JRST [ PUSHJ P,REPLIN ;NO - REPLACE WHOLE LINE
POP P,A
POPJ P,] ;& RETURN
OUTSTR [ASCIZ/
/]
AOS -1(P) ;TELL CALLER WE'RE SPLITTING A LINE
HRRZ T,-1(P) ;See who called us
CAIN T,DUBCR4+2 ;Was it αβ<cr> command?
SKIPE EDCNM ;And did he call us with nothing in front of αβ<cr>?
SKIPA T,EDTBS ;No, normal case
JRST POPAJ ;Yes, don't insert blank line
LSH T,1 ;2 TABS/TAB
ADD T,EDPOS
PUSH P,C
PUSHJ P,PUTBAK ;PUT FIRST PART BACK
PUSH P,B
MOVEI A,1
PUSHJ P,MOVARR ;TO THE NEXT LINE
PUSHJ P,INSONA ;AND MAKE A NEW ONE
POP P,B
MOVE D,[440700,,BUF]
ILDB C,B ;COPY REST OF TEXT DOWN WHERE REPLACER EXPECTS IT
IDPB C,D
JUMPN C,.-2
POP P,C
POP P,A
POPJ P,
DUBLCR: TRNN F,EDITM
JRST DUBCR1
DUBCR4: PUSHJ P,LECR ;This label is used by LECR to identify calling routine
JRST DUBCR3
TRZ F,EDITM+EDBRK
PUSH P,A
PUSHJ P,REPRST ;PUT THE REST BACK
POP P,A
DUBCR1: TRNN F,ARG
JRST LININS ;NO ARG -ENTER LINE INSERT MODE
DUBCR2: MOVNS A ;INVERT SENSE OF ARROW MOVING
JRST INSNUL ;ARG GIVEN - INSERT N BLANK LINES
;Here when αβI or αβ<cr> given at end of line being edited
DUBCR3: PUSH P,A ;Save arg if any
MOVEI A,1
SKIPE EDCNM ;If line was completely blank, enter insert mode above it
PUSHJ P,MOVARR ;Otherwise, go into insert mode below it
POP P,A
JRST DUBCR1
;INSONA, INSONE, INSNUL, INSNLP
;INSNUL INSERTS |C(A)| NULL LINES BEFORE (+) OR AFTER (-) THE ARROW
INSONA: SKIPA A,[-1]
INSONE: MOVEI A,1
INSNUL: MOVM D,A ;# TO INSERT
JUMPE D,CPOPJ
PUSH P,A
ADDM D,LINES
SKIPG XXLINE ;Are there marks on this page
JRST .+4
PUSH P,D
PUSHJ P,XLALL ;Fix up marks
POP P,D
PUSHJ P,LINSET ;# LINES HAS CHANGED
MOVEI B,(D)
LSH B,1
ADDM B,CHARS
MOVSI T,WINBIT
SKIPE A,WINLIN
ANDCAM T,TXTFLG(A) ;Was ANDCAM T,1(A)
SETZM WINLIN
MOVEI B,LLDESC+1
MOVSI C,TXTCOD
MOVSI E,ARRBIT
MOVSI G,2 ;Count of 2,,0 for a null line
MOVE H,[ASCID/
/]
INSNLP: PUSHJ P,FSGET
HLLM C,-1(A)
MOVE T,ARRLIN
HLL T,(T)
MOVEM T,(A)
HRLM A,(T)
ANDCAM E,TXTFLG(T) ;Was ANDCAM E,1(T)
MOVS T,T
HRRM A,(T)
MOVEM A,ARRLIN
MOVEM G,TXTCNT(A)↔HLLM E,TXTFLG(A) ;Was MOVEM G,1(A)
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
MOVEM H,LLDESC(A)
SOJG D,INSNLP
PUSHJ P,SETWRT
MOVE A,TOPWIN
SKIPL (P)
ADD A,(P) ;MOVE WINDOW INSTEAD OF ARROW
PUSHJ P,SETWIN ;RECOMPUTE
POP P,A ;ORIGINAL ARG
JUMPGE A,MOVARR
TLO F,NULLIN
TLZ F,PMLIN
POPJ P,
;LININS, LININ, LININ0, LININ1
LININS: TLOE F,LINSM ;NOW IN LINE INSERT MODE
POPJ P, ;WE WERE ALREADY IN LINE INSERT MODE, DON'T RECURSE
MOVEI T,"↔"
DPB T,[10700,,ARRON]
MOVEM F,FSAV#
SETOM NLININ# ;NO LINES INSERTED
LININ: AOS NLININ ;Count a line inserted
PUSHJ P,INSONA ;Create the line
; PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
; JFCL ;LOADMT skips if expanding macro
; PUSHJ P,EDGBSL ;This dispatches on activator by JRST to cmd routine
MOVEI A, ;Zero repeat arg
PUSHJ P,EDIT
JRST LININ0
JRST LININ1
TLNE F,LINSM
JRST LININ ;Another line please
JRST POPJ2
LININ1: TLNE F,LINSM
JRST LININ ;Another line please
JRST POPJ1
LININ0: TLNE F,LINSM
JRST LININ ;Another line please
POPJ P,
;PPSET ABCRLF ABCRL0 CMDCRL IPPSET DPPSET
IMPURE
PPSET: 0 ;MAIN, EDIT may dispatch to here, others PUSHJ P,@PPSET
JRST CPOPJ ;TTY
JRST DPPSET ;DD
JRST IPPSET ;III
PURE
IPPSET: PPSEL
DPYPOS -1400 ;Move regular III page printer off the page
DPPSET: PPSEL 1
DPYPOS @DPPPOS
DPYSIZ @DPPSIZ ;DPPSIZ contains G=3 L=1 for DD and III
POPJ P,
CMDCRL: HRROI T,[7000,,T] ;Get horizontal position
TTYSET T,
JUMPE T,CPOPJ ;Jump if at left margin
SKIPE DPY ;If not on display, ensure at left margin
CAILE T,=35 ;Don't let horiz pos get beyond this on a display
OUTSTR [ASCIZ/
/]
POPJ P,
ABCRLF: HRROI T,[7000,,T] ;Get horizontal position
TTYSET T,
JUMPE T,CPOPJ ;Jump if already to left margin
OUTSTR [ASCIZ/
/]
POPJ P,
ABCRL0: PUSH P,T ;Don't clobber any ACs!
PUSHJ P,ABCRLF
JRST POPTJ
;OCT3ST NUMSTD NUMSTR OCTSTR OCTASC NUMSIX
;Converts 3 octal digits only into ASCIZ
;Initial value in T, results in C, using A for pointer
OCT3ST: MOVE A,[440700,,C]
MOVEI C,0
MOVEI B,3
IDIVI T,10
HRLM TT,(P)
SOJLE B,.+2
PUSHJ P,.-3
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
;Conversion routine for ASCII and ASCID
NUMSTD: MOVEI C,1 ;This entry used if ASCID is required
MOVE A,[440700,,C] ;and results are left in C
NUMSTR: IDIVI T,=10 ;Converts to DEC ASCII, value in T, pointer in A
JUMPE T,.+4 ;Suppresses leading zeros
HRLM TT,(P)
PUSHJ P,NUMSTR
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
OCTSTR: JUMPGE T,.+4
MOVEI TT,55
IDPB TT,A
MOVNS T
IDIVI T,10 ;Represents OCT in ASCII, value in T, pointer in A
JUMPE T,.+4 ;Suppresses leading zeros
HRLM TT,(P)
PUSHJ P,.-3
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
OCTASC: PUSH P,C ;Represents OCTAL in ASCII, all zeros shown
MOVEI C,14 ;Value in TT, pointer in A
MOVEI T,0
LSHC T,3
ADDI T,"0"
IDPB T,A
SOJG C,.-4
POP P,C
POPJ P,
NUMSIX: IDIVI T,=10 ;Produces six-bit representation of DEC. value
JUMPE T,.+4
HRLM TT,(P)
PUSHJ P,NUMSIX
HLRZ TT,(P)
ADDI TT,'0'
IDPB TT,A
POPJ P,
;SETWRT SETWR2 SETWRX BTAB SETWR4 CLEARX
SETWRT: SETZM DELFIL ;File has changed so don't delete it because of ∂.
SKIPE G,XPLST
PUSHJ P,RCOMP
TRO F,DSPSCR
TLO F,DSPTRL ;Force recalculation of trailer values
MOVE H,WFLAG
TRO F,WRITE
TLO H,"W"⊗13
TRNE F,FILLUZ
JRST SETWR2
MOVE T,CHARS
CAMLE T,ROOM
JRST [ TRO F,XPAGE
TLO H,"X"⊗4
JRST SETWR2]
TRZ F,XPAGE
TLZ H,3760
SETWR2: HLRZ T,@ARRLIN
CAIN T,PAGE
TLOA T,PMARK
HLL T,TXTFLG(T) ;Was MOVE T,1(T)
TLNE T,PMARK
TROA F,UPDTXT
TRNE F,UPDIR+UPDTXT
TRO H," D"⊗1
SETWRX: CAMN H,WFLAG
POPJ P,
MOVEM H,WFLAG
MOVEM H,WFLAG2
MOVE G,SCRTOP
HLLZS DPYTAB(G)
POPJ P,
;Called by APPEND when done--in case X was on before but needn't be now.
CLEARX: MOVE H,WFLAG
MOVE T,CHARS
CAMLE T,ROOM
POPJ P, ;X must have already been on
TRZ F,XPAGE
TLZ H,3760 ;Turn off "X"
JRST SETWRX
BTAB: 0↔@↔5↔3↔1↔@↔4↔2
;FRD FRD0 FRD1 NOEXT NOPRG NOPPN NOSWIT SWITL FRDMSG FLHACK FRD0A SETDEV FRD2 FRD2A NOPP1 SWLOP FRDX FRDX2 SIXOUT
;Takes skip return unless improper syntax encountered.
;FRDxxx flags used in left half of D in FRD and related file-specification code
FRD: SETZM (D)
SETZM 1(D)
SETZM 2(D)
TRZ F,FILLUZ ;Assume new file will be ok.
MOVE T,PPN
MOVEM T,3(D)
MOVSI T,'DSK'
MOVEM T,-1(D) ;Set default value
SETZM -2(D) ;When non-zero used to introduce FF's after # lines
SETZM 4(D)
FRD0: TLZ F,TF1 ;Clear the quote flag. (Set by down-arrow in name.)
TLZ D,FRDDEV!FRDPRG!FRDPRJ!FRDEXT!FRDNAM ;No parts of name seen yet.
FRD0A: PUSHJ P,GETNAM
JUMPN A,FRD2 ;Jump if name given.
JUMPL D,FRD2 ;Jump if from XRUN command looking for program name.
CAIN C,"∂"
JRST FRDMSG ;MSG file name coming.
CAIN C,"\" ;Filehack?
JRST FLHACK ;Yes
CAIE C,175
JRST FRD2 ;Don't abort unless he said ALT
SKIPE ZATT ;Is there an ε or λ command to be aborted?
PUSHJ P,EPSIL4 ;Yes. This PUSHJ won't return here.
EXIT ;We haven't edited any files, so abort the easy way.
SETDEV: MOVEM A,-1(D)
TLO D,FRDDEV
JRST FRD0A
FRD2: CAIN C,":"
JRST SETDEV
JUMPE A,FRD1
TLNE D,FRDTMP
SETZM 1(D) ;Clear any extension read from TMPCOR file
TLO D,FRDNAM
FRD2A: MOVEM A,(D)
FRD1: CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
HLLZM A,1(D)
TLO D,FRDEXT
NOEXT: CAIE C,"["
JRST NOPPN
PUSHJ P,GETP
JUMPE A,.+3
HRLM A,3(D)
TLO D,FRDPRJ ;Project seen
CAIE C,","
JRST NOPRG
PUSHJ P,GETP
JUMPE A,NOPRG
HRRM A,3(D)
TLO D,FRDPRG ;Programmer name found
NOPRG: CAIE C,"]"
JRST NOPPN
PUSHJ P,TYI
JFCL ;used to be JRST FRDX, which didn't initialize flags, page & line.
NOPPN: TLNE D,FRDTMP ;If overriding TMPCOR filename, initialize things
TLNN D,FRDDEV!FRDPRG!FRDPRJ!FRDEXT!FRDNAM ;Any part of name seen?
JRST SWLOP ;No
TLNN D,FRDNAM!FRDPRG!FRDPRJ
JRST NOPP1 ;If only DEV or EXT given, use PPN from TMPCOR
MOVE T,PPN
TLNN D,FRDPRJ ;Any project given?
HLLM T,3(D) ;No, use default
TLNN D,FRDPRG ;Any programmer given?
HRRM T,3(D) ;No, use default
NOPP1: SETOM SLINE ;Clear any values from TMPCOR file
SETOM SPAGE
HLLZS CREASW
SETZM -2(D)
TRZ F,FILLUZ
SETZM RDONLY
IFN BOOKMD, {
SETZM BOOKSW
};END BOOKMD
SETZM QUIETF
SETZM 4(D)
MOVSI T,'DSK'
TLNN D,FRDDEV ;Use DSK if no device name seen
MOVEM T,-1(D)
SWLOP: CAIN C,"("
JRST SWITL
CAIN C,"/"
JRST SWIT1
FRDX: SKIPN EDFIL-2
JRST FRDX2
TRO F,FILLUZ
SKIPE RDONLY
HRLOM D,4(D)
FRDX2: JUMPL D,FRDX3 ;No filename required for XRUN command and friends
SKIPN ZATT ;Are we reading original filename from TTY?
JRST FRDX3 ;Yes, no filename required
SKIPN (D) ;Did we see a filename?
POPJ P, ;No, error return
FRDX3: CAIE C,15
CAIN C,";"
JRST POPJ1
CAIE C,"←"
CAIN C,"→"
JRST POPJ1
CAIE C,40
CAIN C,11
JRST .+2 ;SKIP SPACES AT END OF NAME
POPJ P,
PUSHJ P,TYI
JRST FRDX2 ;Check again
JRST FRDX2 ;May skip
REPEAT 0,<
NOPP2: TLNE D,FRDPRJ!FRDPRG ;Seen any PPN?
JRST NOPPN ;Yes, here from partial sign--don't clobber PPN
TLNE D,FRDTMP
TLNN D,FRDNAM
JRST NOPPN
MOVE T,PPN ;Use default PPN instead of that from TMPCOR
MOVEM T,3(D)
JRST NOPP1
>;repeat 0
SWIT1: PUSHJ P,DOSWIT
NOSWIT: PUSHJ P,TYI
JRST FRDX
JRST SWLOP
SWITL: PUSHJ P,DOSWIT
CAIN C,")"
JRST NOSWIT
TLNE T,FSPC
JRST SWLOP
JRST SWITL
FRDMSG: PUSHJ P,GETP ;Get programmer name right justified.
JUMPN A,FRDMS2
HRRZ A,RPPN ;Default msg file name--logged in programmer name
FRDMS2: MOVSI B,'MSG'
MOVEM B,1(D) ;Default msg extension
MOVE B,[' 2 2']
MOVEM B,3(D) ;Default msg PPN
TLO D,FRDPRJ!FRDPRG!FRDEXT!FRDNAM ;Have name, extension, and ppn now.
JRST FRD2A
FLHACK: PUSHJ P,GETNAM ;Get filehack name
HRRI B,FHMASK# ;Change byte pointer address to FHMASK
MOVEI TT,77
SETZM FHMASK
SKIPA T,[IOWD HAKLEN,HAKTAB] ;Pointer to filehack name table
IDPB TT,B ;Generate complemented mask in FHMASK
TLNE B,770000
JRST .-2
MOVEI B,0 ;Used to store pointer to unique name, if found
FLHAK1: CAMN A,(T) ;Exact match?
JRST FLHAK6 ;Yes, get filename
MOVE TT,FHMASK ;Get mask
ANDCA TT,(T) ;Get corresponding chars of name from table
CAMN A,TT ;Match?
JRST FLHAK2 ;Yes
FLHAK5: AOBJN T,FLHAK1
JUMPN B,FLHAK7 ;Get filename if found unique match
SORRY <Unrecognized filehack: >
FLHAK4: PUSHJ P,SIXOUT ;Type sixbit name in A
OUTSTR [ASCIZ/. /]
POPJ P, ;Take failure return
FLHAK7: MOVE T,B
FLHAK6: MOVE T,HAKDSP-HAKTAB(T) ;Get pointer to filename
SKIPN TT,(T)
HRRZ TT,RPPN ;Use login programmer name
MOVEM TT,(D) ;Store file name
MOVE TT,1(T)
HLLZM TT,1(D) ;Extension
MOVE TT,[' 2 2']
MOVEM TT,3(D) ;PPN
TLO D,FRDPRJ!FRDPRG!FRDEXT!FRDNAM ;Have name, extension, and ppn now.
JRST NOPPN
FLHAK2: JUMPE B,FLHAK3
JUMPE A,CPOPJ ;Jump if no name given
SORRY <Ambiguous filehack: >
JRST FLHAK4
FLHAK3: MOVE B,T
JRST FLHAK5
SIXOUT: MOVE B,A ;Put sixbit name in B
SIXOU1: JUMPE B,CPOPJ
MOVEI A,
LSHC A,6
ADDI A,40
OUTCHR A
JRST SIXOU1
$MAIL: SIXBIT / MSG/
$DAY: SIXBIT /DAY TXT/
$GRIPE: SIXBIT /GRIPESTXT/
$MAINT: SIXBIT /MAINT TXT/
$NOTIC: SIXBIT /NOTICETXT/
$NAP: SIXBIT / NAP/
$PLAN: SIXBIT / PLN/
$DIGES: SIXBIT /DIGEST /
DEFINE HACKS
< HAKMAC DAY,$DAY
HAKMAC DOWN,$MAINT
HAKMAC DIGEST,$DIGEST
HAKMAC GRIPES,$GRIPE
HAKMAC M,$MAIL
HAKMAC MSG,$MAIL
HAKMAC MAIL,$MAIL
HAKMAC NOTICE,$NOTICE
HAKMAC NAP,$NAP
HAKMAC NS,$NAP
; HAKMAC OPTION,$OPTION
HAKMAC P,$PLAN ;BECAUSE \PLAN MAKES \P, \PL AMBIGUOUS
HAKMAC PL,$PLAN ;(SHORTER FORMS MUST BE LISTED HERE FIRST)
HAKMAC PLAN,$PLAN
HAKMAC PLN,$PLAN
; HAKMAC RPG,$RPG
>
DEFINE HAKMAC(A,B)
< SIXBIT/A/
>
HAKTAB: HACKS
HAKLEN←←.-HAKTAB
DEFINE HAKMAC(A,B)
< B
>
HAKDSP: HACKS
;GETNAM GETNML GETP GETPL DTYI1 DTYI DTYI2
;ACCUMULATE LEFT-ADJUSTED SIXBIT. FROM TTY. TO A.
GETNAM: MOVE B,[440600,,A] ;ACCUMULATE SIXBIT IN A
MOVEI A,0
GETNML: PUSHJ P,DTYI ;GET A CHARACTER
POPJ P, ;SOME SORT OF DELIMITER
SUBI C,40 ;MAKE IT SIXBIT
TLNE B,770000
IDPB C,B ;STUFF SIXBIT UNLESS OVERFLOWING
JRST GETNML ;GATHER MORE
;ACCUMULATE RIGHT ADJUSTED SIXBIT. FROM TTY. TO A.
GETP: MOVEI A, ;ACCUMULATE IN A.
GETPL: PUSHJ P,DTYI ;GOBBLE.
POPJ P, ;DELIMITER SEEN
TRNE A,770000 ;FULL YET?
JRST GETPL ;YES. WAIT FOR DELIM
LSH A,6 ;MAKE ROOM
IORI A,-40(C) ;ADD THIS CHARACTER
JRST GETPL ;LOOP
DTYI1: TLCA F,TF1 ;TOGGLE ESCAPE FLAG
DTYIS: JUMPN A,CPOPJ
DTYI: PUSHJ P,TYIU ;READ TTY OR RESCANNED DATA
POPJ P, ;NONE LEFT
CAIN C,"_" ;Quoting a space with underbar?
JRST [MOVEI C,40↔JRST POPJ1] ;Yes
CAIN C,"↓" ;TOGGLE ESCAPE MODE?
JRST DTYI1 ;YES. DO IT
TLNE F,TF1 ;IN ESCAPE MODE?
JRST DTYI2 ;YES. NEARLY ANYTHING GOES.
TLNE T,FSPC ;IS CHARACTER A SPECIAL?
POPJ P, ;YES. RETURN IT
CAIE C,11
CAIN C,40
JRST DTYIS ;IGNORE SPACES AND TABS
DTYI2: CAIGE C,40 ;LEGAL?
TLZ F,TF1 ;NO! CLEAR QUOTE MODE FLAG.
JRST POPJ1 ;RETURN THIS AS LEGAL CHARACTER
;DOSWIT DOSWI2 NTYI NTYIL NTYIM EDFIL EDFIL2 SRCFIL DSTFIL
DOSWIT: PUSHJ P,NTYI
JUMPL D,CPOPJ
CAIN C,"L"
MOVEM A,SLINE#
CAIN C,"P"
MOVEM A,SPAGE#
CAIN C,"N"
HRLOM D,4(D)
CAIN C,"R"
SETCAM A,RDONLY#
CAIN C,"Q"
SETCAM A,QUIETF#
CAIN C,"Z" ;TEMP PAGE,LINE HACK
JRST [ MOVEM A,SPAGE# ↔ MOVEM B,SLINE# ↔ JRST .+1 ]
CAIN C,"C"
SETCAM A,CREASW#
IFN BOOKMD, {
CAIN C,"B"
SETCAM A,BOOKSW#
SKIPE BOOKSW
SETOM RDONLY ;BOOKSW IMPLIES RDONLY ALSO
};END BOOKMD
CAIE C,"E"
JRST DOSWI2
MOVEM A,SPAGE ;Arg is page number to start at end of.
MOVSI B,777 ;This oughta be big enough line and/or page number.
MOVEM B,SLINE
JUMPN A,DOSWI2
MOVEM B,SPAGE ;No arg means start up at end of last page of file.
DOSWI2: CAIE C,"F"
POPJ P,
JUMPG A,.+2
MOVEI A,=33 ;Default number of lines/page in /F mode.
HRRZM A,EDFIL-2 ;/F means insert FFs every so many lines.
JFCL ;SPACE FOR USE WHILE DEBUGGING
; HRLOM D,4(D) ;/F implies /N
POPJ P,
NTYI: MOVEI A,
NTYIL: PUSHJ P,TYIU
POPJ P,
TLNN T,NUMF
JRST NTYIM
IMULI A,12
ADDI A,-"0"(C)
JRST NTYIL
NTYIM: JUMPN A,NTYICM
CAIE C,"-"
JRST NTYICM
PUSHJ P,NTYIL
MOVN A,A
JUMPN A,NTYICM
MOVNI A,1
NTYICM: CAIE C,","
POPJ P,
PUSH P,A ;, MEANS WE HAVE X OF X,Y IN A. SAVE IT AND GET Y
PUSHJ P,NTYI
MOVE B,A
POP P,A
POPJ P,
;- CAUSES NTYI TO CALL ITSELF FOR |NUMBER|. COMMA CAUSES CALL TO SELF FOR Y OF X,Y
IMPURE
0 ;For /F mode line count.
0 ;For device name.
EDFIL: BLOCK 6
0
0
EDFIL2: BLOCK 6
0
0
SRCFIL: BLOCK 5
0
0
DSTFIL: BLOCK 5
PURE
;RSCAN, RSCAN0, RSCAN1, RSCAN2, RSCAN3, RSCAN4, RSCN4B, RSCN4C, RSCN4A, RSCN0A
;CALLED FROM BEG0. RESCAN TTY.
; RETURNS RSPNT,TYIPNT, AND SYSCMD
; TYIPNT = BYTE POINTER TO FILE NAME PORTION OF COMMAND LINE.
; SYSCMD = SIXBIT COMMAND NAME (2 LETTERS) FOR EDITOR COMMANDS
RSCAN: RESCAN T ;RESCAN TTY (HERE AT NORMAL START)
JUMPLE T,CPOPJ ;NOTHING THERE?
;ENTER HERE FOR DEBUGGER (DON'T DO RESCAN, SET T INFINITE)
RSCAN0: PUSHJ P,RSTYI1 ;READ CHARACTER FROM TTY. UPPER CASE
POPJ P, ;NONE THERE
SOJLE T,CPOPJ ;DECREMENT COUNT. RETURN IF RUN OUT
CAIE C," "
CAIN C,11
JRST RSCAN0 ;IGNORE LEADING BLANKS AND TABS
MOVE A,[440700,,BUF] ;INITIALIZE BYTE POINTER
IFE BOOKMD, {
CAIE C,"R" ;IN BOOKMD, HAVE TO ACCEPT "READ" SYSTEM COMMAND
};END ¬BOOKMD
CAIN C,"S"
JRST RSCAN3 ;S OR START COMMAND
MOVEI B,-40(C) ;CONVERT CHARACTER TO SIXBIT
PUSHJ P,RSTYI1 ;GET ANOTHER CHARACTER
POPJ P,
IFN BOOKMD, {
CAIN B,'R'
CAIN C,"E"
JRST RSCN0A ;STARTED BY ETV, CETV, OR READ COMMANDS
MOVEI TT,RSCAN3+1 ;R OR RUN COMMAND
JRST RSTYI0
RSCN0A:
};END BOOKMD
SOJLE T,CPOPJ
SUBI C,40 ;CONVERT TO SIXBIT
DPB B,[60600,,C] ;SAVE FIRST SIXBIT CHARACTER.
PUSHJ P,SYSCCK ;CHECK TWO RIGHT ADUSTED SIXBIT CHRS
JRST RSCAN6 ;CEtv, ETv, EDit, CReate, or REad COMMAND
RSCAN1: TLNN T,-1 ;DON'T UNDERSTAND. COMMAND. FLUSH!
PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
POPJ P, ;(IF T>777777 THEN RETURN NOW!
RSCAN2: SOJG T,RSCAN1 ;read in and ignore rest of faulty command
RSCANX: SETZM SYSCMD
SETZM RSPNT
POPJ P,
;HERE IF SYSTEM START/RUN COMMAND SEEN. READ TO ";" THEN READ FILE NAME.
RSCAN3: JSP TT,RSTYI ;GET NEXT. WE SAW A MONITOR RUN COMMAND
JRST RSCAN2 ;WAS CR
SOJG T,RSCN4D ;WAS ";" READ FILE NAME NEXT
SOJG T,RSCAN3 ;WAS LEGAL, IGNORE IT
POPJ P, ;(RAN OUT OF TEXT)
;HERE TO GOBBLE FILE NAME. STOW IT USING "A" AS A BYTE POINTER
RSCN4D: MOVEM A,RSPNT ;POINTER TO FIRST BYTE OF FILE NAME.
RSCAN4: JSP TT,RSTYI ;GOBBLE TEXT
JRST RSCAN5 ;CR ENDS SCAN
SOJG T,RSCAN8 ;FLUSH AFTER SEMI-COLON
RSCN4B: IDPB C,A ;STOW TEXT
SOJG T,RSCAN4 ;GOBBLE MORE TEXT
JRST RSCANX ;UNEXPECTED END OF DATA, ACT UNHAPPY
;AT RSCN4A TO FLUSH BLANKS AND TABS BEFORE SCANNING NAMES.
RSCN4C: JSP TT,RSTYI
JRST RSCAN5 ;CR SEEN
SOJG T,RSCAN8 ;SEMI-COLON SEEN. FLUSH THE REST. BE HAPPY.
RSCN4A: CAIE C," " ;IGNORE BLANKS AND TABS
CAIN C,11
SOJG T,RSCN4C ;IGNORE BLANKS AND TABS
MOVEM A,RSPNT ;SOME NON-BLANK SEEN
JRST RSCN4B ;SET POINTER AND GOBBLE TEXT
;RSCAN5, RSCAN6, RSCAN7, RSCAN8, SYSCCK, CRECHK
RSCAN5: IDPB C,A ;CR SEEN. STOW IT
PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
JRST RSCANX
SOJLE T,RSCANX ;VARIOUS WAYS TO BE UNHAPPY
CAIE C,12
JRST RSCANX
IDPB C,A ;STOW LF AND NULL
MOVEI C,
IDPB C,A
TLNN T,-1 ;SKIP IF T>777777 (NOT RESCAN)
SOJG T,RSCAN1 ;IF THERE'S MORE, UNHAPPY
MOVE A,[440700,,BUF]
MOVEM A,TYIPNT ;SET UP POINTER TO TEXT
POPJ P, ;RETURN HAPPY
;HERE WHEN EDIT COMMAND SEEN.
RSCAN6: LSH C,6 ;MOVE COMMAND TO L.ADJ IN RIGHT HALF
HRLZM C,SYSCMD ;SAVE 6BIT COMMAND LEFT ADJUSTED
RSCAN7: JSP TT,RSTYI ;GOBBLE
JRST RSCAN5 ;END OF TEXT. ACT HAPPY. (E.G., "ET<CR>")
SOJG T,RSCAN8 ;SEMICOLON MEANS COMMENT HERE
CAIL C,"A"
CAILE C,"Z"
JRST RSCN4A ;SOME NON-LETTER SEEN. GOBBLE FILE NAME
SOJG T,RSCAN7 ;FLUSH UNTIL A DELIMITER SEEN
JRST RSCANX
;FLUSH INPUT THROUGH CR. ";" SEEN AFTER FILE NAME SCAN BEGAN.
RSCAN8: JSP TT,RSTYI
JRST RSCAN5 ;CR SEEN. BE HAPPY
SOJG T,RSCAN8
SOJG T,RSCAN8
JRST RSCANX
SYSCCK: CAIE C,'ET'
CAIN C,'ED'
POPJ P,
IFN BOOKMD, {
CAIN C,'RE'
POPJ P,
};END BOOKMD
CRECHK: CAIE C,'CE'
CAIN C,'CR'
POPJ P,
JRST POPJ1
;RSTYI RSTYI0 RSTYI1 UCASE TYI1 TYI2 TYI3 TYI4 TYI5 TYI6 TYICHK CTYI1 CTYI2 POPUP POPCJ CSTYI1
;READ TTY. RETURN CHARACTER IN C.
;RETURN +1 ON CR, +2 ON ";" AND +3 ON OTHERS,
; EXCEPT, NO DATA RETURNS TO RSCANX, ILLEGAL CHAR RETURNS TO RSCAN2
RSTYI: PUSHJ P,RSTYI1
JRST RSCANX
IFN BOOKMD, {
RSTYI0:
};END BOOKMD
CAIN C,15
JRST (TT)
CAIN C,";"
JRST 1(TT)
CAIN C,11
JRST 2(TT)
CAIE C,"→"
CAIN C,"↓"
JRST 2(TT)
CAIE C,"∂" ;Legal to mean MSG file
CAIN C,"_" ;Legal to mean quoted space
JRST 2(TT)
CAIL C,40
TRNE C,600
JRST RSCAN2
JRST 2(TT)
;READ TTY, SKIP RETURN UPPER CASE ONLY IN "C".
RSTYI1: PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
POPJ P,
AOS (P)
UCASE: CAIGE C,"a"
POPJ P,
CAIG C,"z"
SUBI C,"a"-"A"
POPJ P,
TYI4: ILDB C,TYIPNT
JUMPN C,POPUP
SETZM TYIPNT
SKIPN TYIINS#
JRST POPUP
XCT TYIINS
SETZM TYIINS
POPUP: SUB P,[1,,1]
POPJ P,
TYI5: ILDB C,MACPNT
JUMPN C,POPUP
SETZM MACPNT#
SKIPE MACINS#
XCT MACINS
JRST POPUP
;Routine to check byte pointers for input character.
;Returns up a level with character in C if successful.
TYICHK: SKIPE TYIPNT
JRST TYI4
SKIPE MACPNT ;Macro expansion in progress?
JRST TYI5 ;Yes
POPJ P,
;Below are the only routines authorized to do TTY input,
;except for the EDIT routine. This is because of the EMODE 400s.
;Routine to read a character in line mode.
TYI1: PUSHJ P,TYICHK ;If byte ptr set up, get char and return up a level.
TYI2: INCHWL C ;Read from TTY.
TYI3: CAIE C,15
JRST TYI6
INCHWL C ;Read the LF following the CR.
XORI C,15≠12 ;Turn LF into CR, maintaining bits.
TYI6: PUSH P,C
SNEAKS C, ;Check for a 400 lurking in the shadows.
JRST POPCJ ;Nothing at all lurking.
CAIN C,400
INCHRW C ;Gobble the 400 and discard it.
POPCJ: POP P,C
POPJ P,
;Routine to read a character in character mode.
CTYI1: PUSHJ P,TYICHK ;Check for byte ptr first
CTYI2: INCHRW C
JRST TYI3 ;Go check for a CRLF and a following 400.
;Routine to read a single character and skip if got one. No special action on CR.
CSTYI1: INCHRS C
POPJ P,
AOS (P)
JRST TYI6
;TYI, TYIT, TYIU
;Use with caution because of skip return
TYI: PUSHJ P,TYI1
TYIT: TRNE C,600
POPJ P, ;Direct return for activation character.
HLL T,CTAB(C)
TLNN T,LSPC!NSPEC
JRST POPJ1 ;Skip return for normal character.
JUMPE C,TYI
PUSH P,T
MOVN T,CTAB(C) ;Get dispatch displacement for this character.
HRLI T,400000
LSH T,(T)
TLNN T,744000 ;Skip for NULL, RUBOUT, CR, LF, ALTMODE
AOS -1(P) ;Not an activation char.
POP P,T
POPJ P,
TYIU: PUSHJ P,TYI
POPJ P,
TLNE T,LETF
TLNN T,LT2F
JRST POPJ1
SUBI C,40
JRST POPJ1
;TMPRED, TMPRD1, TMPRD2, TMPRDX, RPGRD1, BKPRED
TMPMAX←←37
;TCBUF←←BUF2
TMPRED: MOVE T,[1,,['ED '↔-TMPMAX,,TCBUF-1]]
IFN BOOKMD, {
SKIPE BOOKSW ;use different tmpcor filename in /B mode
MOVE T,[1,,['BK '↔-TMPMAX,,TCBUF-1]]
};END BOOKMD
TMPCOR T, ;SEEK TMPCOR FILE
JRST RPGRED ;NONE. TRY TO READ QQSVED.RPG
TMPRDY: JUMPLE T,CPOPJ ;NO DATA?
CAILE T,TMPMAX ;OVERFLOW?
POPJ P, ;YES. THAT'S TOO MUCH WORK.
SETZM TCBUF(T) ;MAKE SURE WE STOP.
MOVE T,[440700,,TCBUF]
TMPRD1: MOVE G,T ;G←POINTER TO BYTE BEFORE THE FIRST REAL CHARACTER.
ILDB C,T ;GET A CHARACTER
CAILE C,40 ;DELIM?
JRST TMPRD2 ;NO. REAL.
JUMPN C,TMPRD1 ;LOOP UNTIL A REAL CHARACTER IS SEEN.
POPJ P, ;BUT IF THERE AREN'T ANY, WE QUIT
TMPRD2: ILDB C,T ;NOW, WE SKIP UNTIL WE SEE SOME REAL STUFF.
CAIG C,40 ;REAL CHARACTER?
JRST TMPRDX ;NO. WE HAVE SKIPPED THE ET OR CET PART.
JUMPN C,TMPRD2 ;WHILE WE'RE STILL IN BUSINESS...
POPJ P, ;OOPS.
TMPRDX: MOVEM T,TYIPNT ;THIS POINTS TO THE ARGUMENT PORTION.
MOVEM T,TCPNT ;(G POINTS TO THE COMMAND NAME)
JRST POPJ1 ;INDICATES WE WON.
RPGRED: MOVE T,[['DSK '↔'QQSVED'↔'RPG '↔0↔0],,LKUP-1]
IFN BOOKMD, {
SKIPE BOOKSW ;LOOK FOR DIFFERENT RPG FILE IN /B MODE
MOVE T,[['DSK '↔'QQBKP '↔'RPG '↔0↔0],,LKUP-1]
};END BOOKMD
MOVEI C,DSKI
PUSHJ P,OPNDEV ;NOTE THAT OPNDEV SKIPS ON FAILURE
LOOKUP DSKI,LKUP
JRST RELDEV
IFN BOOKMD, {
RPGRD1: ;BKPRED (SEE BELOW) ENTERS HERE TO READ .BKP FILE
};END BOOKMD
INPUT DSKI,[-TMPMAX,,TCBUF-1↔0]
PUSHJ P,RELDEV
MOVS T,LKUP+3
MOVN T,T ;SET UP POSITIVE WORD COUNT
JRST TMPRDY
IFN BOOKMD, {
BKPRED:
TLNN D,740 ;FILENAME SPECIFIED?
JRST BKPRD0 ;NO, LOOK FOR .BKP FILE
SKIPG SLINE ;YES. /#L OR /#P SPECIFIED?
SKIPLE SPAGE ;
JRST BKPRD1 ;YES. IGNORE .BKP FILE
SKIPE RDONLY ;/R SPECIFIED?
JRST BKPRD1 ;YES. IGNORE .BKP FILE
BKPRD0: MOVE T,[['DSK '↔0↔'BKP '↔0↔0],,LKUP-1]
MOVEI C,DSKI
PUSHJ P,OPNDEV ;OPNDEV skips on failure
SKIPN T,EDFIL ;LOOK FOR .BKP FILE WITH SAME FIRST NAME AS BOOK FILE
JRST BKPRD2 ;RELEASE DSK. (SHOULD NEVER BE HERE)
MOVEM T,LKUP ;USE EDIT FILE'S NAME FOR .BKP FILE
MOVE T,EDFIL+3 ;PICK UP PPN FROM COMMAND
JSP TT,BKPLKP ;LOOKUP .BKP FILE ON PPN GIVEN IN COMMAND
MOVE T,PPN ;NOT FOUND. TRY AGAIN ON USER'S CURRENT AREA
JSP TT,BKPLKP
MOVE T,RPPN ;NOT FOUND. TRY AGAIN ON USER'S LOGGED IN PPN
JSP TT,BKPLKP
JRST BKPRD2 ;NOT FOUND THERE EITHER
BKPLKP: MOVEM T,BKPPPN# ;SAVE PPN OF .BKP FILE
MOVEM T,LKUP+3
LOOKUP DSKI,LKUP
JRST (TT) ;DIRECT RETURN ON FAILURE
PUSHJ P,RPGRD1 ;READ IN FILE AND SCAN PAST "ET" PART. RELEASE DSK.
JRST BKPRD1 ;ILLEGAL FORMAT, IGNORE .BKP FILE
MOVEI D,EDFIL2
PUSHJ P,FRD ;GET FILENAME FROM .BKP FILE
JRST BKPRD1 ;ILLEGAL FORMAT, IGNORE .BKP FILE
MOVE T,BKPPPN ;GET PPN OF .BKP FILE
TLNN D,600 ;DID .BKP FILE SPECIFY A PPN?
MOVEM T,EDFIL2+3 ;NO. USE .BKP FILE'S PPN FOR ACTUAL BOOK FILE
MOVE T,[EDFIL2-1,,EDFIL-1]
BLT T,EDFIL+5 ;NO. MAKE FILENAME FROM .BKP FILE THE FILE TO EDIT
; HLLOS NEWBKP ;SET FLAG INDICATING USE OF .BKP FILE
POPJ P,
BKPRD2: PUSHJ P,RELDEV ;NO .BKP FILE FOUND
SETZM BKPPPN
TLNE D,740 ;WAS A FILENAME SPECIFIED?
SETOM NEWBKP# ;YES, FLAG TO TELL USER WE WILL CREATE A .BKP FILE
TLNN D,740 ;WAS A FILENAME SPECIFIED?
BKPRD1: SETZM BKPSW ;NO. DON'T WRITE .BKP FILE
POPJ P,
};END BOOKMD
;TMPWRT, BKPWRT, TMPCOR
TMPWRT: SKIPN SYSCMD
POPJ P,
TMPCOR: SETZM TCBUF
MOVE T,[TCBUF,,TCBUF+1]
BLT T,TCBUF+TMPMAX-1
MOVE T,[440700,,TCBUF]
MOVEM T,TYOPNT
TYPCHR "ET"
TYPCHR " "
MOVEI D,EDFIL
PUSHJ P,FILSTR
SKIPE PAGE
TDZA T,T
MOVEI T,1
PUSH P,TYOPNT
TYPCHR "("
IFN BOOKMD, {
SKIPE BOOKSW
TYPCHR "B"
};END BOOKMD
SKIPE RDONLY
TYPCHR "R"
; SKIPE EDFIL-2 ;FILSTR now puts in /N if appropriate
; JRST TMPWR2
; XCT (T)[SKIPN DIRPAG↔SKIPE EDFIL+4]
; TYPCHR "N"
TMPWR2: XCT (T)[SKIPA TT,CURPAG↔SKIPGE TT,SPAGE]
JRST .+3
TYPDEC TT
TYPCHR "P"
XCT (T)[SKIPA TT,ARRL↔SKIPGE TT,SLINE]
JRST .+3
TYPDEC TT
TYPCHR "L"
LDB T,TYOPNT
TYPCHR ")"
POP P,TT
CAIN T,"("
MOVEM TT,TYOPNT
TYPCHR "
"
MOVE T,TYOPNT
IFN BOOKMD, {
SETZ C, ;MAKE SURE LOSING 4 BITS ARE ZERO ANYWAY (DISK DUMP MODE FEATURE)
};END BOOKMD
IFE BOOKMD, {
TDZA C,C
};END ¬BOOKMD
IDPB C,T
TLNE T,760000
JRST .-2
MOVNI TT,-TCBUF+1(T)
MOVSI TT,(TT)
HRRI TT,TCBUF-1
MOVSI T,'ED '
IFN BOOKMD, {
SKIPE BOOKSW ;USE DIFFERENT TMPCOR FILENAME IN /B MODE
MOVSI T,'BK '
};END BOOKMD
MOVE A,[3,,T]
TMPCOR A,
JFCL
POPJ P,
IFN BOOKMD, {
BKPWRT: PUSH P,TT ;SAVE DUMP MODE OUTPUT COMMAND
MOVE T,[['DSK '↔0↔'BKP '↔0↔0],,ENTR-1]
MOVEI C,RPGO
PUSHJ P,OPNDEV ;skips on failure
JRST BKPWR2 ;DSK OPENED
BKPWR1: SUB P,[1,,1] ;CANT OPEN DISK OR CANT ENTER .BKP FILE
JRST RELDEV
BKPWR2: MOVE T,EDFIL ;PICK UP PRIMARY NAME OF FILE BEING EDITED
MOVEM T,ENTR ;AND USE IT FOR .BKP FILE'S PRIMARY NAME
MOVE T,BKPPPN ;REMEMBER WHAT DISK AREA THE .BKP FILE IS TO BE ON
MOVEM T,ENTR+3
ENTER RPGO,ENTR ;MAKE <FILENM>.BKP FILE
JRST BKPWR1
POP P,T ;RETRIEVE DUMP MODE COMMAND
SETZ TT,
OUTPUT RPGO,T
MOVE T,CURPAG
CAME T,PAGES ;ARE WE ON THE LAST PAGE OF THE BOOK?
JRST RELDEV ;NO
CLOSE RPGO, ;YES, DELETE .BKP FILE
SETZM ENTR
MOVE T,BKPPPN
MOVEM T,ENTR+3
RENAME RPGO,ENTR ;HIE THEE AWAY
JFCL
JRST RELDEV
};END BOOKMD
;FILERR, FILTYP, FILSTR, PPNTYP, FILETB
FILERR: HRRE T,1(D)
CAIGE T,NFLERS
SKIPA TT,FILETB(T)
MOVEI TT,[ASCIZ \UNRECOGNIZED LOOKUP/ENTER ERROR: \]
OUTSTR (TT)
SETZM TYOPNT
MOVE A,-1(D)
HLRZ T,TT
JUMPN T,(T)
FILTYP: SETZM TYOPNT
FILSTR: MOVE A,-1(D)
CAMN A,['DSK ']
JRST FILST2
PUSHJ P,SIXTYO
TYPCHR ":"
FILST2: MOVE A,(D)
PUSHJ P,SIXTYO
HLLZ A,1(D)
JUMPE A,PPNTYP
TYPCHR "."
PUSHJ P,SIXTYO
PPNTYP: SKIPE A,3(D)
CAMN A,PPN
JRST FILST3
TYPCHR "["
HLLZS A
PUSHJ P,PNTYO
TYPCHR ","
HRLZ A,3(D)
PUSHJ P,PNTYO
TYPCHR "]"
FILST3: SKIPN -2(D) ;/F mode?
JRST FILST4 ;No.
TYPCHR "/"
TYPDEC -2(D)
TYPCHR "F"
POPJ P,
FILST4: SKIPE 4(D) ;/N mode?
TYPCHR "/N" ;Yup
POPJ P,
[ASCIZ /DEVICE NOT DISK: /]
SIXTYO,,[ASCIZ /DEVICE CAN'T BE OPENED: /]
FILETB: [ASCIZ /FILE NOT FOUND: /]
PPNTYP,,[ASCIZ /USER NOT FOUND: /]
[ASCIZ /PROTECTION FAILURE: /]
[ASCIZ /FILE IN USE: /]
NFLERS←←.-FILETB
;SIXTYO, SIXTYL, SIXTY2, SIXTYN, SIXTNL, SIXTNN, PNTYO, PNTYOL
SIXTYO: MOVE B,[440600,,A]
SIXTYL: ILDB C,B
JUMPE C,SIXTYN
SIXTY2: TYPCHR 40(C)
TLNE B,770000
JRST SIXTYL
POPJ P,
SIXTYN: MOVEI T,1
SIXTNL: TLNN B,770000
POPJ P,
ILDB C,B
JUMPN C,SIXTNN
AOJA T,SIXTNL
SIXTNN: TYPCHR "_"
SOJG T,.-1
JRST SIXTY2
PNTYO: JUMPE A,CPOPJ
MOVE B,[440600,,A]
ILDB C,B
JUMPE C,.-1
PNTYOL: JUMPN C,.+2
MOVEI C,"_"-40
TYPCHR 40(C)
TLNN B,500000
POPJ P,
ILDB C,B
JRST PNTYOL
;UUOH, UUODSP, UFCE, UTYPCH, UTYPC2, UTYPDE, UTYPOC
UUOH: PUSH P,T
LDB T,[331100,,40]
CAIG T,NUUOS
SKIPGE T,UUODSP(T)
PUSHJ P,TELLZ
EXCH T,(P)
POPJ P,
UUODSP: -1
UUOS{,U!X
}
UFCE: HRRZ T,40
CAIN T,T
SKIPA T,-1(P)
MOVE T,(T)
POPJ P,
UTYPCH: EXCH T,40
ROT T,-7
TRNE T,177
PUSHJ P,UTYPC2
ROT T,7
PUSHJ P,UTYPC2
MOVE T,40
POPJ P,
UTYPC2: SKIPN TYOPNT
OUTCHR T
SKIPE TYOPNT
IDPB T,TYOPNT#
POPJ P,
UTYPDE: PUSHJ P,UTYPR
POPJ P,12
UTYPOC: PUSHJ P,UTYPR
POPJ P,10
;UTYPR UTYPR1 USORRY UFATAL FATFIX TELLX TELLZ FATFI2 PANIC
UTYPR: PUSH P,T
HRRZ T,@-1(P)
MOVEM T,RADIX#
PUSHJ P,UFCE
PUSHJ P,UTYPR1
POP P,T
POPJ P,
UTYPR1: PUSH P,TT
IDIV T,RADIX
JUMPE T,.+2
PUSHJ P,UTYPR1
MOVEI T,"0"(TT)
PUSHJ P,UTYPC2
POP P,TT
POPJ P,
USORRY: PUSHJ P,ABCRL0 ;Get to left margin, preserving ACs
OUTSTR [ASCIZ /SORRY -- /]
OUTSTR @40
OUTSTR [ASCIZ / /]
JRST MACSTP ;Terminate macro expansion.
FATMES: ASCIZ /Former WRITE CODE ERROR for CHARS/
FATME2: ASCIZ /Former WRITE CODE ERROR for OBLK/
;FATFIX and FATFI2 are referenced on page 167
FATFIX: PUSH P,[FATMES]
JRST FATFI3
FATFI2: PUSH P,[FATME2]
FATFI3: OUTSTR [ASCIZ /
An attempt will be made to fix a formerly FATAL BUG IN WRITE CODE error.
/]
EXCH T,(P) ;Save T and get address of error message
MOVEM T,40
POP P,T
SETOM TELFL2
PUSHJ P,FBI
MOVEM T,CHARS
POPJ P,
;To replace former JRST 4,. 's in dispatch tables by PUSHJ P,TELL#
TELL0: PUSHJ P,TELLX
ASCIZ /NUL character in text/
TELL1: PUSHJ P,TELLX
ASCIZ /RUBOUT character in text/
TELL2: PUSHJ P,TELLX
ASCIZ /CR out of place/
TELL3: PUSHJ P,TELLX
ASCIZ /LF out of place/
TELL4: PUSHJ P,TELLX
ASCIZ /TAB out of place/
TELL5: PUSHJ P,TELLX
ASCIZ /FF out of place/
TELL6: PUSHJ P,TELLX
ASCIZ /ALT MODE in text/
TELL7: PUSHJ P,TELLX
ASCIZ /Unexpected non-special character/
TELL8: PUSHJ P,TELLX
ASCIZ /Unexpected ; or ⊗/
TELL9: PUSHJ P,TELLX
ASCIZ /Unexpected digit/
TELLD: PUSHJ P,TELLX ;Used on page 99 and following
ASCIZ /DIRECTORY trouble/
TELLZ: PUSHJ P,TELLX
ASCIZ /Unknown error/
TELLX: POP P,40 ;Get address of error message into location 40
UFATAL: JSR PANIC
JRST 4,. ;Stop until I know what to do
IMPURE
PANIC: 0
JRST TELLX2
PURE
TELLX2: SETOM TELFL2#
PUSH P,40 ;FBI clobbers 40
POP P,CRASH2#
PUSHJ P,FBI
PPSEL
OUTSTR [ASCIZ /
A fatal error has been detected and reported: /]
OUTSTR @CRASH2#
OUTSTR [ASCIZ/
/]
SKIPE CRASH#
JRST 2,@PANIC ;Don't recur through here
SETOM CRASH#
OUTSTR [ASCIZ/Trying to save your text in an emergency file...
/]
MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE 17,SAVEAC+17
PUSHJ P,SAVE ;Try to save user's text in emergency file
JFCL ;SAVE usually skips
MOVSI 17,SAVEAC
BLT 17,17 ;Restore ACs
JRST 2,@PANIC
;OPENI, OPNOI, IOPEN, SETI, SETRLD, OPNDEV, RELDEV, OPNLUZ
;Note possible skip return
OPENI: TLZ F,ENTRD
SKIPA C,[DSKI]
OPNOI: MOVEI C,DSKO
DPB C,[270400,,%LKUP]
DPB C,[270400,,%IN]
DPB C,[270400,,%SETI]
DPB C,[270400,,%STAT]
MOVEM C,ICHN#
MOVE T,[JRST WRBF3] ;For channel DSKI don't set IBLK when setting OBLK
CAIE C,DSKI
MOVE T,[MOVE T,OBLK] ;For channel DSKO, IBLK must be set to OBLK-1
MOVEM T,XSETO#
MOVEI T,(C)
XORI T,DSKI≠DSKO
DPB T,[270400,,%RELS]
XCT %RELS
SETZM JOBJDA(T)
IOPEN: MOVSI T,-1(D)
HRRI T,LKUP-1
PUSHJ P,OPNDEV ;skips on failure, with error in LOOKUP block
XCT %LKUP
POPJ P,
SETZM IBLK
MOVS T,LKUP+3
MOVNM T,FILWC#
ASH T,-7
MOVNM T,FILLEN#
HLLZ T,LKUP+2
TLZ T,37
; IOR T,DATBLK ;MUST FIX ****** FOR ACCTIM NOT DSKTIM
MOVEM T,2(D)
LDB T,[POINT 12,DATBLK,17] ;Get 12 low ordeer bits of date
DPB T,[POINT 12,2(D),35]
LDB T,[POINT 11,DATBLK,35] ;Now the time in minutes
DPB T,[POINT 11,2(D),23]
HRRZ T,LKUP+1
HRRM T,1(D)
LDB T,[POINT 3,DATBLK,5] ;But don't forget the 3 high order bits
DPB T,[POINT 3,1(D),20]
AOS (P)
SETI: TRZ F,EOF
MOVE T,IBLK
CAIN T,-1(A)
JRST SETI2
HRRZM A,IBLK#
SOS IBLK
XCT %SETI
SETI2: HLLZ T,A
ROT T,7
ADD T,IBFPNT
MOVEM T,NEWPNT#
SETRLD: MOVE T,[440700,,IBFE]
HRRZM T,ABFEND ;SET UP ADDRESS OF THE END OF THE BUFFER.
MOVEM T,INPNT#
POPJ P,
IMPURE
%OPEN: OPEN OPNBLK
%RELS: RELEAS
%LKUP: LOOKUP LKUP
%IN: IN [-200,,IBUF-1↔0]
%SETI: USETI (A)
%STAT: GETSTS C
%CSTAT: CHNSTS TT
OPNBLK: 17↔0↔0
IBFPNT: 10700,,IBUF-1
0
0
LKUP: BLOCK 4
PURE
;Skips on failure, with error returned in LOOKUP/ENTER block
OPNDEV: MOVE TT,T
BLT TT,3+1(T)
CAMLE C,JOBHCU↑
JRST .+3
SKIPGE JOBJDA↑(C)
POPJ P,
DPB C,[270400,,%CSTAT]
XCT %CSTAT
TRNE TT,400000
POPJ P,
DPB C,[270400,,%OPEN]
MOVE TT,(T)
MOVEM TT,OPNBLK+1
XCT %OPEN
JRST [HLLOS 1+1(T)↔JRST POPJ1]
MOVEI TT,(C)
DEVCHR TT,
TLNE TT,DVDSK
POPJ P,
MOVEI TT,-2
HRRM TT,1+1(T)
AOS (P)
RELDEV: DPB C,[270400,,%RELS]
XCT %RELS
SETZM JOBJDA(C)
POPJ P,
OPNLUZ: PUSH P,A
MOVEI D,LKUP
PUSHJ P,FPAUSE
OUTSTR [ASCIZ /LOOKUP./]
MOVSI D,EDFIL
POP P,A
SOS (P)
JRST IOPEN
;RLD, RLD1, RLD2, RLDX, RLDLUZ, FIXEOF, ENTLUZ, ENTL2,RLDCHK
;HERE IF WE FOUND A RUBOUT IN THE INPUT FILE.
;USUALLY THIS MEANS WE'RE AT END OF RECORD, BUT IT MAY HAVE BEEN
;A RUBOUT FROM THE FILE ITSELF.
;CALLING SEQUENCE IS:
; ILDB C,BADR
; SKIPG CTAB(C)
; XCT @CTAB(C) ;SUBJECT INSTRUCTION IS: PUSHJ P,RLD
RLD: MOVE C,(P) ;CALLER'S ADDRESS.
HRRZ C,@-3(C) ;ADDRESS PART OF BYTE POINTER
CAME C,ABFEND# ;IS THIS THE LAST WORD OF THE BUFFER?
JRST [AOS RLDRUB#↔POP P,C↔JRST -3(C)]
;NO. WAS R-O FROM FILE. RETURN AND IGNORE.
XCT %IN ;TIME TO READ MORE. (IN UUO)
RLD1: AOSA C,IBLK ;COUNT A BLOCK READ
JRST RLDLUZ ;HERE WE HAVE EOF OR ERROR (IN UUO SKIPPED)
CAMN C,TSTBLK#
PUSHJ P,@TSTSET#
RLD2: MOVE C,IBFPNT
EXCH C,NEWPNT ;FANCY NEW POINTER WILL NEXT TIME BE NORMAL
RLDX: EXCH C,(P) ;STORE POINTER SO
POP P,@-3(C) ;THE POP CLOBBERS THROUGH THE ILDB
JRST -3(C) ;RETURN TO THE ILDB
RLDLUZ: XCT %STAT ;GET STATUS (INTO C)
TRNN C,20000 ;EOF?
PUSHJ P,TELLZ ;NO. BARF. SOME REAL ERROR
MOVE C,IBLK ;GET THE NUMBER OF SUCCESSFULLY READ BLOCKS
LSH C,7 ;LAST SUCCESSFULLY READ WORD
CAMGE C,FILWC ;BIGGER THAN FILE WORD COUNT?
JRST FIXEOF ;NO. WE HAVE JUST READ A PARTIAL BUFFER.
TRNN F,REDNLY ;Don't clear /F mode count in /R mode.
SETZM EDFIL-2 ;No longer in /F mode, so clear
TROE F,EOF ;SET FLAG FOR EOF
JRST RLD2 ;WE WERE THROUGH HERE BEFORE.
MOVE C,[BYTE (7)14] ;PUT FF WHERE WE'LL SEE IT
MOVEM C,IBUF
MOVEI C,1 ;NOW ARRANGE FOR SOME RUB OUTS
JRST FIXEF1
FIXEOF: SUB C,FILWC
MOVN C,C
FIXEF1: PUSH P,IBFE
POP P,IBUF(C)
MOVEI C,IBUF(C)
MOVEM C,ABFEND ;SET END OF BUFFER'S ADDRESS
JRST RLD1
ENTLUZ: PUSH P,A
PUSH P,D
MOVEI D,ENTR
PUSHJ P,FPAUSE
OUTSTR [ASCIZ /ENTER./]
MOVEI C,DSKO
PUSHJ P,RELDEV ;STUPID SYSTEM!
LDB T,[270400,,%LKUP]
CAIE T,DSKO
JRST ENTL2
MOVE A,IBLK
MOVEI D,EDFIL
PUSHJ P,IOPEN
PUSHJ P,OPNLUZ
ENTL2: POP P,D
POP P,A
MOVEI E,EDFIL
JRST OPENO
;EXTCHK, EXTCH1, EXTCH2, EXTCH3, EXTCH4, EXTTAB
EXTCHK: HRRZ T,LKUP+1
JUMPN T,POPJ1
MOVE T,@SRCFIL+3
MOVEM T,OBUF
MOVSI T,'UFD'
MOVEM T,OBUF+1
MOVE T,['1 1']
MOVEM T,OBUF+3
MOVE T,SRCFIL
TLNN T,FRDEXT ;Don't do this is explicit extension typed.
LOOKUP DSKI,OBUF
JRST POPJ1
MOVNS T,OBUF+3
MOVE B,@SRCFIL
MOVEI C,-1
EXTCH1: MOVN T,OBUF+3
JUMPGE T,EXTCH4
CAMGE T,[-200,,]
MOVSI T,-200
ADDM T,OBUF+3
HRRI T,IBUF-1
MOVE A,T
MOVEI TT,
INPUT DSKI,T
EXTCH2: CAME B,1(A)
JRST EXTCH3
HLRZ T,2(A)
MOVSI TT,-NEXTS
CAIE T,@EXTTAB(TT)
AOBJN TT,.-1
CAILE C,(TT)
SKIPGE EXTTAB(TT)
JRST EXTCH3
MOVEI C,(TT)
HRLZM T,@SRCFIL+1
EXTCH3: ADD A,[4,,4]
JUMPL A,EXTCH2
JRST EXTCH1
;Note skip return
EXTCH4: CAIL C,-1
AOS (P)
MOVSI T,400000
HLLM T,SRCFIL+1
POPJ P,
EXTTAB: FOR X IN(FAI,SAI,F4,PUB,POX,MAC,LSP,LAP,PAL,MIC,WRU,NSA,OSA,LST,CMD,<TXT>
,RELX,DMPX,XGPX,DRWX,WD X,PC X,WPCX,PLTX,PCPX,PLXX,WL X,WLSX)
{ (<SIXBIT /X/>)
}NEXTS←←.-EXTTAB
0
;OPENW, OPENO, SETO, FPAUSE, PAUSE, PAUS2, BYE
OPENW: TRNN F,REDNLY
TLOE F,ENTRD
JRST OPENO2
OPENO: MOVSI T,-1(E)
HRRI T,ENTR-1
MOVEI C,DSKO
PUSHJ P,OPNDEV ;skips on failure
ENTER DSKO,ENTR
JRST ENTLUZ
SETZM OBLK#
OPENO2: PUSHJ P,WRBF1
MOVE T,[OBUF-1,,OBUF]
TLNN F,CLRBF ;ALREADY DONE?
BLT T,OBUF+177
POPJ P,
SETO: HRRZM A,OBLK
USETO DSKO,(A)
JRST WRBF2
FPAUSE: HRRE T,1(D)
JUMPGE T,PAUSE
PUSHJ P,PAUSE
OUTSTR [ASCIZ /OPEN./]
POPJ P,
PAUSE: SKIPG DPY
JRST PAUS2
PUSH P,G
PUSH P,SCRSIZ
PUSHJ P,FINI2
POP P,SCRSIZ
POP P,G
PPACT 200000 ;Select PP1
PTWR1W [0↔10000+"N"] ;ONLY WAY TO NORMALIZE PP
PAUS2: SETZM TYOPNT
TYPCHR 15*200+12
PUSHJ P,FILERR
OUTSTR [ASCIZ /
Type CONTINUE to retry /]
XCT @(P)
BYE: PUSHJ P,LOADMT ;Fix up his line editor.
JFCL ;LOADMT skips if expanding a macro
EXIT 1,
PUSHJ P,TYI6 ;Gobble any extra 400 floating around.
JRST POPJ1C
;CLOSO CLOSO2 WRBUF WRBF1 WRBF2 WRBF3 WRBF4 ENTR OBUF IBUF IBFE
CLOSO2: MOVE D,OPNT
CAMN D,[700,,OBUF-1]
JRST POPUP ;Return up a level.
TDZA T,T
IDPB T,D
TLNE D,760000
JRST .-2
HRLI D,1(D)
ADDI D,2
CAMG D,[OBUF+177,,OBUF+200]
SETZM -1(D)
CAMGE D,[OBUF+177,,OBUF+200]
BLT D,OBUF+177
POPJ P,
CLOSO: PUSHJ P,CLOSO2
WRBUF: OUT DSKO,[-200,,OBUF-1↔0]
WRBF1: AOSA OBLK
WRBF4: PUSHJ P,TELLZ
WRBF2: PUSH P,T
XCT XSETO ;JRST WRBF3 or MOVE T,OBLK
SUBI T,1 ;Input channel is same, so copy output block
MOVEM T,IBLK ; pointer to input block pointer.
WRBF3: MOVEI T,200*5
MOVEM T,OCNT#
MOVE T,[700,,OBUF-1]
MOVEM T,OPNT#
MOVE T,[OBUF-1,,OBUF]
TLNE F,CLRBF
BLT T,OBUF+177
POP P,T
POPJ P,
IMPURE
0
0
ENTR: BLOCK 4
0 ;FOR BLT
OBUF: BLOCK 200
0 ;Guard for backed up pointer case
IBUF: BLOCK 200
IBFE: -2
PURE
;INTLUZ, INTDSP, PDLOV, PDLOV1, PDLOV2, PDLOV3, ISAV, TSINT, TSNINT
TSINT: MOVEM T,ISAV ;HERE FOR INTERRUPT (OLD DEC STYLE)
MOVEM TT,ISAV+1 ;SAVE SOME AC'S
MOVE T,JOBCNI ;THIS IS THE REASON WE'RE HERE
JFFO T,.+1 ;CONVERT BIT NUMBER TO INDEX (WHOOPEE!)
CAIL TT,MININT ;IN RANGE?
CAILE TT,MAXINT
INTLUZ: PUSHJ P,TELLZ ;UNEXPECTED TYPE OF INTERRUPT
JRST 2,@INTDSP-MININT(TT) ;DISPATCH TO PARTICULAR INTERRUPT SERVER
INTDSP: PDLOV
INTLUZ
INTLUZ
MORCOR
MAXINT←←.-INTDSP+MININT
TSNINT: MOVE T,JBICNI ;FIGURE OUT WHY WE WERE INTED
TLNN T,4 ;SHOULD BE ESC I
DISMIS ;OH WELL
SETOM ESCIEN
SKIPN MACXIP
JRST TSNIN2 ;No macro in progress.
MOVE T,MACPNT
MOVEM T,MACSAV# ;Save byte pointer to unexecuted part of macro.
MOVEI T,1 ;Terminate macro in progress.
MOVEM T,MACPNT ;Ensure that ILDB MACPNT will load a zero.
MOVE T,[JRST MACINT]
MOVEM T,MACINS
SETZM MACXIP
TSNIN2: MOVE T,JOBTPC ;Save this before goddamn UWAIT clobbers it!
MOVEM T,SAVTPC#
UWAIT ;Wake up any SLEEP in progress
MOVE T,SAVTPC
MOVEM T,JOBTPC
DISMIS
IMPURE
JBICNI: 0 ;THIS THREE CONSECUTIVE WORDS USED INSTEAD OF .JBCNI, TPC, AND APR
JBITPC: 0 ;FOR NEW INTS (I.E. ESC I INTS)
JBIAPR: TSNINT ;GO TO TSNINT FOR NEW STYLE INTS
ESCIEN: 0 ;NON ZERO WHEN EXTENDED SEARCH SHOULD GRIND TO A HALT
ESCI2: 0 ;Flag saying we have just been interrupted by ESC I
PURE
IFND: MOVEM TT,IFRET#
IFND1: CAIL T,BEG
CAMLE T,JOBREL
JRST IFND3
IFND2: MOVE T,(T)
MOVEM T,INTINS#
MOVE T,ISAV
MOVE TT,ISAV+1
MOVEI T,@INTINS
HLRZ TT,INTINS
ANDI TT,777000
CAIN TT,(<XCT>)
JRST IFND1
LDB TT,[270400,,INTINS]
CAIE TT,T
CAIN TT,TT
ADDI TT,ISAV-T
MOVEM TT,IFACP#
HLRZ TT,INTINS
ANDI TT,¬37
AOS IFRET
JRST @IFRET
IFND3: CAMLE T,JOBHRL↑
JRST @IFRET
JRST IFND2
PDLOV: SKIPE SFSPNT
JSP SBARF
TLNN P,-1
CAMLE P,JOBREL
JRST TRYPSH
HLRZ T,(P)
ANDI T,357637
CAIE T,310000
CAIN T,10000
JRST PDLOV2
TRYPSH: SOS T,JOBTPC
JSP TT,IFND
JRST PDLUNK
ANDI TT,777000
CAIE TT,(<PUSH>)
PDLUNK: PUSHJ P,TELLZ
MOVE T,@IFACP
HLRZ T,(T)
JUMPN T,PDLUNK
MOVN TT,[1,,1]
ADDM TT,@IFACP
JRST INTPOV
PDLOV2: SUB P,[1,,1]
HRRZ T,1(P)
SUBI T,1
JSP TT,IFND
AOBJP P,TRYPSH
CAIN TT,(<PUSHJ P,>)
CAIE T,@JOBTPC
AOBJP P,TRYPSH
SOS T,1(P)
MOVEM T,JOBTPC
JRST INTPOV
IMPURE
ISAV: BLOCK 3
PURE
;FSINI FSINI1 MORCOR INTERR INTX INTPOV
FSINI: MOVE T,JOBREL
CAMLE T,JOBFF
JRST FSINI1
ADDI T,2000
CORE T,
STOPJ
MOVE T,JOBREL
FSINI1: AOJ T,
MOVEM T,FSMAX#
SUB T,JOBFF
HRROM T,@JOBREL
HRROM T,@JOBFF
MOVEM T,FSFREE#
MOVE T,JOBFF
MOVEM T,FSMIN#
MOVEM T,FSBEG#
SETZM FSUSE#
POPJ P,
MORCOR: HRRZ T,JOBTPC ;HERE FOR ILL MEM REF
MOVSI TT,-LEGCNT
CAME T,LEGTAB(TT) ;IS INTERRUPT PC= TO ONE OF LEGAL VALUES?
AOBJN TT,.-1
JUMPGE TT,INTERR ;JUMP IF NOT A MEMBER OF LEGTAB
MOVE T,JOBREL ;LET'S GET MORE CORE.
ADDI T,2000
CAILE T,377777 ;MAKE SURE WE DON'T GET TOO BLOATED
JRST [OUTSTR [ASCIZ/I JUST GOT TOO BLOATED.
/]
HALT MORCOR]
CORE T,
STOPJ ;(BARF)
MOVE T,SUBONE ;Processor flag: KL/KI v. KA.
AOJE T,INTX ;Jump if not KA
;REG 1/1/74 TO FIX AC OF PUSH THAT GOT ILM
LDB T,[POINT 9,@JOBTPC,8] ;GET OP CODE
CAIE T,(<PUSH>⊗-9) ;IS THIS A PUSH?
JRST INTX ;NO. EXIT NOW.
MOVE T,@JOBTPC ;GET LOSING PUSH.
HRRI T,ISAV ;CHANGE ADDRESS PART TO CLOBBER USELESS CELL
TLC T,(<PUSH>≠<POP>) ;CHANGE PUSH TO A POP
MOVEM T,ISAV+2 ;SAVE IT WHERE WE'LL XCT IT.
MOVE T,ISAV
MOVE TT,ISAV+1
XCT ISAV+2 ;RESTORE T AND TT, THEN FIX THE PUSH AC
JRST 2,@JOBTPC
;We don't try to report PDL OVs nor do we try to save incore text--no stack space
INTPOV: MOVE T,JOBENB↑
MOVEI TT,
APRENB TT,
JRST INTX2 ;Cause the PDL OV again without interrupts
INTERR: MOVEI TT,[ASCIZ/Ill mem ref/]
MOVEM TT,40
MOVE T,JOBENB↑
MOVE TT,JOBTPC
MOVEM TT,ILMADR# ;SAVE ADDRESS OF LOSING INSTRUCTION FOR FBI
MOVEI TT,
APRENB TT,
JSR PANIC ;Report the error and try to write out text
INTX2: SLEEP TT,
MOVEM T,JOBENB
INTX: MOVE T,ISAV
MOVE TT,ISAV+1
JRST 2,@JOBTPC ;Re-execute the losing instruction, for better or worse
;FSGET, FSLUP0, FSLUP, FSGRAB, FSXIT
FSGET: TSTSHF
MOVEI T,2(B)
CAMLE T,FSFREE
SOJA T,FSNEW
MOVEI TT,
MOVE A,FSBEG
FSLUP0: SKIPL T,(A)
JRST FSUSED
FSLUP: SKIPL T,(A)
JRST FSNEXT
CAIG B,-2(T)
TRNN T,-2
JRST FSTSML
FSGRAB: HRRZ TT,T
ADDI T,(A)
CAIN B,-2(TT)
JRST FSXIT
SUBI TT,2(B)
HRROM TT,-1(T)
SUBI T,(TT)
HRROM TT,(T)
MOVEI TT,2(B)
FSXIT: CAMN A,FSBEG
HRRZM T,FSBEG
MOVEM TT,-1(T)
MOVEM TT,(A)
ADDM TT,FSUSE
MOVNS TT
ADDM TT,FSFREE
AOJA A,CPOPJ
;FSNEWT, FSNEWP, FSNEW
FSNEWT: MOVEI T,1(B)
FSNEWP: POP P,D
POP P,C
FSNEW: MOVE TT,FSMAX
SKIPGE -1(TT)
SUB TT,-1(TT)
ADDI T,(TT)
CAMLE T,JOBREL
CALLI T,11
STOPJ ;MACRO for PUSHJ P,STOPJC
MOVE A,FSMAX
SKIPGE T,-1(A)
SUBI A,(T)
MOVE T,JOBREL
AOJ T,
MOVE TT,T
SUB TT,FSMAX
ADDM TT,FSMAX
ADDM TT,FSFREE
SUBI T,(A)
HRROM T,(A)
HRROM T,@JOBREL
JRST FSGRAB
;FSUSED, FSTSML, FSNEXT, FSHRET, FSLLUZ
FSUSED: ADDI A,(T)
MOVEM A,FSBEG
JRST FSLUP0
FSTSML: CAIL TT,(T)
JRST FSNEXT
HRRZ TT,T
MOVEM A,FSBIG#
FSNEXT: ADDI A,(T)
CAMGE A,FSMAX
JRST FSLUP
JUMPE TT,[STOPJ]
MOVEI T,40(B)
TLNN F,NOSHUF
CAMLE T,FSFREE
SOJA T,FSNEW
PUSH P,C
PUSH P,D
SUBI TT,2(B)
MOVE A,FSBIG
PUSHJ P,FSLSCN
JRST FSLLUZ
MOVEI T,2(B)
LSHC C,-2
CAML C,T
SOJA T,FSNEWP
LSHC C,2
PUSHJ P,FSLSHF
FSHRET: POP P,D
POP P,C
JRST FSGRAB
FSLLUZ: MOVEI T,100(B)
CAMLE T,FSFREE
SOJA T,FSNEWP
PUSHJ P,FSLSHF
MOVNI TT,2(B)
PUSHJ P,FSHSCN
JRST FSNEWT ;NO CAN DO - SOMETHING MUST BE LOCKED
MOVEI T,2(B)
LSH C,-1
CAML C,T
SOJA T,FSNEWP
PUSHJ P,FSHSHF
JRST FSHRET
;FSLSCN, FSLSCL, FSLFR, FSLSHF, FSLSLP, FSLMOV, FSLDON
FSLSCN: MOVEI C,
FSLSCL: CAMGE A,FSBEG
POPJ P,
MOVE T,-1(A)
SUBI A,(T)
SKIPGE T,(A)
JRST FSLFR
TLNE T,LOKBIT
JRST [ADDI A,(T)↔POPJ P,] ;CAN'T MOVE IT
ADDI C,(T)
JRST FSLSCL
FSLFR: ADDI TT,(T)
JUMPL TT,FSLSCL
JRST POPJ1
FSLSHF: CAMG A,FSBEG
ADDM C,FSBEG
MOVEI C,
FSLSLP: CAML A,FSBIG
JRST FSLDON
SKIPL T,(A)
JRST FSLMOV
SUBI C,(T)
ADDI A,(T)
JRST FSLSLP
FSLMOV: HRRZS T
PUSHJ P,PNTREL
PUSHJ P,FSBLT
ADDI A,(T)
JRST FSLSLP
FSLDON: CAML A,FSMAX
TDZA T,T
HRRZ T,(A)
MOVE TT,T
ADDI TT,-1(A)
SUB T,C
HRROM T,(TT)
ADD A,C
HRROM T,(A)
POPJ P,
;FSHSCN, FSHSCL, FSHFR, FSHSHF, FSHSLP, FSHSR, FSHMOV
FSHSCN: MOVEI C,
FSHSCL: SKIPGE T,(A)
JRST FSHFR
TLNE T,LOKBIT
JRST [HRRZ T,-1(A)↔SUBI A,(T)↔POPJ P,] ;CAN'T MOVE
ADDI C,(T)
FSHSC2: ADDI A,(T)
CAMGE A,FSMAX
JRST FSHSCL
POPJ P,
FSHFR: ADDI TT,(T)
JUMPL TT,FSHSC2
JRST POPJ1
FSHSHF: MOVEI C,
FSHSLP: SKIPL T,(A)
JRST FSHMOV
ADDI C,(T)
FSHSR: CAMG A,FSBIG
JRST FSHSX
MOVE T,-1(A)
SUBI A,(T)
JRST FSHSLP
FSHSX: SKIPN T,C
POPJ P, ;JUST IN CASE
ADDI C,-1(A)
HRROM T,(C)
HRROM T,(A)
CAMGE A,FSBEG
MOVEM A,FSBEG
POPJ P,
FSHMOV: ANDI T,-1
PUSHJ P,PNTREL
PUSHJ P,FSBLT
JRST FSHSR
;FSBLT, POPTJ, FSBLT1
;MOVES (T) WORDS LOCATED AT (A) A DISTANCE OF (C). CLOBBERS D & TT
FSBLT: CAILE T,(C)
JUMPGE C,FSBLT1
JUMPLE T,CPOPJ
MOVE TT,A
ADD TT,C
HRL TT,A
PUSH P,T
ADDI T,(TT)
BLT TT,-1(T)
POPTJ: POP P,T
POPJ P,
FSBLT1: CAILE C,5
JRST FSBLT2
JUMPE C,CPOPJ
PUSH P,B
PUSH P,E
MOVSI E,377777(T)
HRRI E,(A)
ADD E,T
MOVSI B,(<POP E,(E)>)
HRRI B,(C)
MOVE C,[JUMPL E,B]
MOVE D,[JRST .+2]
SOJA E,B
HRRZ C,B
POP P,E
POP P,B
POPJ P,
;FSBLT2, FSBLT3, FSHBLT, FSHBL2
FSBLT2: HRRM C,FSHBLT
SOS FSHBLT
HRLS C
MOVE D,A
ADDI D,(C)
PUSH P,T
IDIVI T,(C)
MOVE T,(P)
ADD T,A
HRLS T
ADDI T,(C)
JUMPE TT,FSBLT3
HRRM TT,FSHBL2
SOS FSHBL2
HRLS TT
SUBB T,TT
XCT FSHBL2
FSBLT3: SUB T,C
MOVE TT,T
XCT FSHBLT
CAIGE D,(T)
JRST FSBLT3
HRRZS C
JRST POPTJ
IMPURE
FSHBLT: BLT TT,(T)
FSHBL2: BLT TT,(T)
PURE
;PNTREL, SHFTB, STDSH1, STDSHF, RELOC, RELOCL
;Note skip return
PNTREL: CAMN A,FSBLK#
JRST [ ADDM C,FSBLK
ADDM C,FSBL2#
JRST .+1]
HLRZ TT,(A)
CAIL TT,MXSHF
PUSHJ P,TELLZ
MOVE D,A
ADD D,T
HLRZ D,-1(D)
SKIPN C
AOSA (P)
PUSHJ P,@SHFTB(TT)
HRRZ T,(A)
POPJ P,
DEFINE SHFCOD!(X){X!COD←←.-SHFTB X!SHF}
SHFTB: STDSHF
SHFCOD DIR
SHFCOD TXT
MXSHF←←.-SHFTB
STDSH1: HLRZ T,D
PUSHJ P,RELOC
ANDI D,-1
STDSHF: JUMPN D,STDSH1
POPJ P,
LSTSHF: MOVE T,1(A)
LSTSH1: MOVSI C,(C)
PUSHJ P,RELOCL
MOVS T,T
HLRE C,C
RELOC: SKIPA TT,(T)
RELOCL: HLRZ TT,(T)
CAIE A,-1(TT)
PUSHJ P,TELLZ
ADDM C,(T)
POPJ P,
;FSGIVE, FSGIV1, FSGIV2
FSGIVE: CAMGE A,FSMAX
CAMGE A,FSMIN
STOPJ ;MACRO for PUSHJ P,STOPJC
PUSH P,A
PUSH P,B
HRROS TT,-1(A)
SOS B,A
ADDI B,(TT)
HRROS -1(B)
MOVNI TT,(TT)
ADDM TT,FSUSE
MOVN TT,TT
ADDM TT,FSFREE
CAMLE A,FSMIN
SKIPL T,-1(A)
JRST FSGIV1
SUBI A,(T)
ADDI TT,(T)
HRROM TT,(A)
ADDI T,(A)
HRROM TT,-1(B)
FSGIV1: CAMGE B,FSMAX
SKIPL T,(B)
JRST FSGIV2
ADDI TT,(T)
HRROM TT,(A)
ADDI B,(T)
HRROM TT,-1(B)
FSGIV2: CAMGE A,FSBEG
MOVEM A,FSBEG
TLNN F,NOCHK
PUSHJ P,CORCHK
JRST POPBAJ
;CORCHK, CRUNCH, CMPACT
CORCHK: TSTSHF
MOVE TT,FSFREE
TLNN F,NOSHUF
JRST .+4
MOVE T,FSMAX
HRRZ TT,-1(T)
SKIPGE -1(T)
CAIGE TT,2200
POPJ P,
TRZ TT,1777
MOVNS TT
PUSHJ P,CRUNCH
HRRO A,FSMAX
SKIPL T,-1(A)
POPJ P, ;OOPS
SUBI T,200 ;LEAVE THIS MUCH ROOM
SUBB A,T
CALLI T,11
STOPJ ;MACRO for PUSHJ P,STOPJC
MOVE T,JOBREL
AOS TT,T
SUB T,FSMAX
ADDM T,FSFREE
ADDB T,FSMAX
SUBI TT,-200(A)
HRROM TT,-200(A)
HRROM TT,-1(T)
POPJ P,
CRUNCH: MOVE A,FSMAX
MOVEM A,FSBIG
PUSH P,C
PUSH P,D
PUSH P,TT
PUSHJ P,FSLSCN
JFCL ;SHOULDN'T HAPPEN UNLESS CORE LOCKED
POP P,T
CAME TT,T
PUSHJ P,FSLSHF
POP P,D
POP P,C
POPJ P,
CMPACT: MOVN TT,FSFREE
JUMPE TT,CPOPJ
PUSH P,A
PUSHJ P,CRUNCH
JRST POPAJ
;ENDSET, ENDFIX
ENDSET: MOVE A,FSMAX
SKIPL TT,-1(A)
MOVEI TT,
SUB TT,FSFREE
HRREI TT,200(TT)
JUMPGE TT,.+2
PUSHJ P,CRUNCH
MOVE A,FSMAX
SKIPGE T,-1(A)
SUBI A,(T)
MOVEM A,FSEND#
MOVEM A,FSEND1#
JUMPGE T,.+3
MOVNI T,(T)
ADDM T,FSFREE
POPJ P,
ENDFIX: MOVEI TT,
EXCH TT,FSEND1
MOVE T,FSEND
SUB T,TT
ADDM T,FSUSE
ADD T,TT
MOVEM T,FSMAX
CAMLE T,JOBREL
POPJ P,
CAMN TT,FSBEG
MOVEM T,FSBEG
MOVE T,JOBREL
AOJ T,
MOVEM T,FSMAX
SUB T,FSEND
HRROM T,@FSEND
HRROM T,@JOBREL
ADDM T,FSFREE
POPJ P,
;FSCHK, FCLUP1, FCLUP2, FCFR, FCDON
IFN DEBSW{
FSCHK: MOVE A,FSMAX
SOJ A,
CAME A,JOBREL
STOPJ ;Fatal error
FSCHK1: SETZB D,E
MOVE A,FSMIN
FCLUP1: CAMN A,FSBEG
JRST FCLUP2
CAML A,FSMAX
STOPJ
SKIPGE T,(A)
STOPJ
PUSHJ P,FUCHK
AOJA B,FCLUP1
FCLUP2: CAMN A,FSMAX
JRST FCDON
CAMLE A,FSMAX
STOPJ
SKIPGE T,(A)
JRST FCFR
PUSHJ P,FUCHK
AOJA B,FCLUP2
FCFR: HLRZ TT,T
CAIE TT,-1
STOPJ
ADDI A,(T)
MOVE TT,-1(A)
CAME TT,T
STOPJ
ADDI E,(T)
JRST FCLUP2
FCDON: CAME D,FSUSE
STOPJ
CAME E,FSFREE
STOPJ
IFE PURESW,<
SKIPL PURFLG
POPJ P,
PUSH P,B
PUSHJ P,PURCHK
POP P,B
> JRST POPJ1
;FUCHK, MOVIT, MOVTX
FUCHK: XCT @-1(P)
HLRZ TT,T
CAIL TT,MXSHF
STOPJ ;MACRO for PUSHJ P,STOPJ
ADDI A,(T)
HLRZ TT,-1(A)
CAMLE TT,JOBREL
STOPJ ;MACRO for PUSHJ P,STOPJ
HRRZ TT,-1(A)
CAIE TT,(T)
STOPJ ;MACRO for PUSHJ P,STOPJ
ADDI D,(T)
POPJ P,
MOVIT: TLNE F,NOSHUF
POPJ P,
SKIPLE SAVMOD
PUSHJ P,SAVIT
SETCMB T,MVPHAZ#
JUMPGE T,CMPACT
PUSH P,A
PUSH P,C
PUSH P,D
MOVE A,FSMIN
MOVEM A,FSBIG
MOVN TT,FSFREE
JUMPE TT,MOVTX
PUSHJ P,FSHSCN
JFCL
ADD TT,FSFREE
JUMPLE TT,MOVTX
PUSHJ P,FSHSHF
MOVTX: POP P,D
POP P,C
JRST POPAJ
;PURINI, PLCHK, PL2CHK, PLCHKL, PLSCN0, PLSCN, PLSCN1, PLSCN2, PLSCN3
IFE PURESW,{
PURINI: JSP G,PLCHK
MOVEM A,PLCHK1
MOVEM B,PLCHK2
JSP G,PLSCN0
MOVEM A,PURCK
MOVSI H,-ADRSIZ
JSP G,PLSCN
MOVEM A,PURCK+1(H)
AOBJN H,.-2
SETOM PURFLG
SKIPE A,JOBDDT
TLNN A,-40
JRST (E)
MOVE A,-6(A) ;$I
HRLI A,(<JSR>)
MOVEM A,BPTINS
JRST (E)
PLCHK: MOVEI TT,PURLST
PL2CHK: SETZB A,B
PLCHKL: XOR A,(TT)
XOR B,-1(TT)
MOVEI T,(TT)
HRRZ TT,(TT)
CAIGE TT,(T)
JUMPN TT,PLCHKL
JRST (G)
PLSCN0: TDZA H,H
PLSCN: MOVEI B,@BITTAB+44-ADRSIZ(H)
MOVEI TT,PURLST
MOVEI A,
PLSCN1: HLRZ T,(TT)
HRLI T,1(T) ;ALLOW FOR CARRY
SUBI T,1(TT)
MOVS T,T
JUMPL H,PLSCN3
XOR A,(T)
AOBJN T,.-1
PLSCN2: HRRZ TT,-1(T)
JUMPN TT,PLSCN1
JRST (G)
PLSCN3: TRNE T,(B)
XOR A,(T)
AOBJN T,PLSCN3
JRST PLSCN2
;PURCHK, PURCH1, PURCH2, PURCH3, PURC3A
PURCHK: JSP G,PLCHK
CAMN A,PLCHK1
JUMPE TT,PURCH1
MOVEI TT,PURLST-1
JSP G,PL2CHK
CAMN A,PLCHK2
JUMPE TT,PURCH4
FATAL BOTH PURE LISTS CLOBBERED
PURCH1: CAME B,PLCHK2
JRST PURCH7
PURCH2: JSP G,PLSCN0
CAMN A,PURCK
POPJ P,
MOVE C,A
XOR C,PURCK
MOVEI D,
MOVSI H,-ADRSIZ
PURCH3: JSP G,PLSCN
CAMN A,PURCK+1(H)
JRST .+4
XOR A,C
IORI D,(B)
CAMN A,PURCK+1(H)
AOBJN H,PURCH3
CAIGE D,ENDPUR
JUMPGE H,.+2
FATAL MULTIPLE LOCATIONS CLOBBERED
REPEAT 0,<
SKIPE LSTCOM
JRST PURC3A
OPEN SWP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,[LOGFIL,,OBUF]
BLT T,OBUF+3
ENTER SWP,OBUF
JRST PURC3B
MOVE T,[74,,OBUF]
BLT T,OBUF+177
MOVE T,41
MOVEM T,JOBS41↑-74+OBUF
OUTPUT SWP,[-200,,OBUF-1↔0]
MOVEI T,OBUF
BLT T,OBUF+17
SETCM T,JOBREL
MOVSI T,274(T)
HRRI T,274-1
MOVEI TT,
OUTPUT SWP,T
OPEN SWP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,[SAVFIL,,OBUF]
BLT T,OBUF+3
ENTER SWP,OBUF
JRST PURC3B
MOVEI A,
MTAPE DSKO,A
USETI DSKO,1
SKIPA T,[-200,,OBUF-1↔0]
OUTPUT SWP,[-200,,OBUF-1↔0]
IN DSKO,[-200,,OBUF-1↔0]
JRST .-2
HLL T,LKUP+3
TLO T,-200
TLNE T,177
OUTPUT SWP,T
USETI DSKO,(A)
PURC3B: RELEAS SWP,
PURC3A:>
XOR C,(D)
MOVE T,(D)
CAME T,BPTINS
CAMN C,BPTINS
JRST PURCLC
PUSH P,TYOPNT
SETZM TYOPNT
OUTSTR [ASCIZ /
LOC /]
TYPOCT D
OUTSTR [ASCIZ / WAS CLOBBERED FROM /]
MOVE T,C
PUSHJ P,TYPHW
OUTSTR [ASCIZ / TO /]
MOVE T,(D)
PUSHJ P,TYPHW
POP P,TYOPNT
MOVEM C,(D)
TRO F,DSPALL
OUTSTR [ASCIZ /
IT'S FIXED. GO ON?/]
PUSHJ P,YESCHK
POPJ P,
JRST 4,.-3
;PURCH4, PURCH5, PURCH6, PURCH7, PURCLC, TYPHW, PURCK, PLCHK1, PLCHK2, PURFLG
PURCH4: MOVEI TT,PURLST-1
MOVEI A,1
PURCH5: MOVSI B,TT
HRRI B,(A)
PURCH6: MOVE T,(TT)
TRNE T,-1
ADD T,A
MOVEM T,@B
HRRZ TT,(TT)
JUMPN TT,PURCH6
JRST PURCH2
PURCH7: MOVEI TT,PURLST
MOVNI A,1
JRST PURCH5
PURCLC: SKIPN PURFLG
POPJ P,
FOR X IN(A,B,E,PURFLG){PUSH P,X↔}
JSP E,PURINI
POP P,PURFLG
POP P,E
JRST POPBAJ
TYPHW: HLRZ TT,T
JUMPE TT,TYPHW2
TYPOCT TT
TYPCHR ","
TYPCHR ","
TYPHW2: MOVEI TT,(T)
TYPOCT TT
POPJ P,
IMPURE
PURCK: BLOCK ADRSIZ+1
PLCHK1: 0
PLCHK2: 0
PURFLG: 0
BPTINS: 0
LOGFIL: SIXBIT /ELOSERDMP )( S FW/
SAVFIL: SIXBIT /ELOSERFIL )( S FW/
PURE
}
;SAVIT
SAVIT: MOVEM OBUF
MOVE [1,,OBUF+1]
BLT OBUF+137
MOVE OBUF
SKIPE T,FBBAND
JRST .+3
UFBGET T,
JRST [OUTSTR [ASCIZ /NO FAST BANDS!
/]↔POPJ P,]
MOVEM T,FBBAND#
MOVE T,JOBREL
SUBI T,140-1
MOVEM T,FBCMD+1
MOVEI T,
FBWRT T,FBCMD
PUSHJ P,TELLZ
POPJ P,
SAVRET: MOVE T,FBCMD+1
ADDI T,140-1
CORE T,
PUSHJ P,TELLZ
MOVEI T,
FBREAD T,FBCMD
PUSHJ P,TELLZ
MOVE [OBUF+1,,1]
BLT 137
MOVE OBUF
SETZM SAVMOD
SETZM JOBOPC
PUSHJ P,@JOBDDT
PUSH P,T
TRZE F,EDITM
SETOM LEPOS
PUSHJ P,DDTRET
SKIPGE LEPOS
TRO F,EDITM
POP P,T
POPJ P,
IMPURE
FBCMD: 140↔0↔3
PURE
;CHECK, CHECK1, CHECK2
CHECK: MOVEI B,
PUSHJ P,FSCHK
JFCL
MOVEM B,FSCNT#
SKIPG CHKMOD
JRST CHECK2
PUSHJ P,CHECK2
PUSHJ P,MOVIT
PUSHJ P,CHECK1
PUSHJ P,MOVIT
CHECK1: MOVEI B,
PUSHJ P,FSCHK
JFCL
CAME B,FSCNT
STOPJ
CHECK2: ADD B,JOBREL
CORE B,
STOPJ
MOVE B,FSMAX
MOVEM B,FSPNT#
PUSHJ P,FSCHK1
HRLZM A,(B)
MOVN B,FSCNT
HRLZ B,B
HRR B,FSPNT
AOBJP B,.+3
HRRM B,-1(B)
AOBJN B,.-1
PUSHJ P,CHKDIR
PUSHJ P,CHKPAG
PUSHJ P,CHKATT
SKIPE FSPNT
STOPJ
MOVE B,FSMAX
SOJ B,
CORE B,
STOPJ
SKIPE SAVMOD
JRST SAVIT
POPJ P,
;CHKDIR, CHKDPL
CHKDIR: MOVEI A,DIR
SETZM CHKCNT#
SETZM CHKTMP#
MOVEI DSP,CDDSP
MOVSI H,NSPEC+LSPC+DSPC
MOVNI D,1
PUSHJ P,CHKDR4
MOVN D,PAGES
HRLZ D,D
PUSHJ P,CHKDR1
AOBJN D,.-1
HRRZ T,(A)
CAIE T,DIREND
PUSHJ P,TELLD
MOVSI T,(A)
CAME T,DIREND
PUSHJ P,TELLD
TLNE DSP,D1BIT
TLNN DSP,DPBIT
PUSHJ P,TELLD
MOVE T,CHKCNT
ADD T,DIROVH
CAME T,DIRSIZ
PUSHJ P,TELLD
MOVEI A,DIREND
PUSHJ P,CHKD4A
SKIPN DPLST
POPJ P,
MOVEI A,DPLST
SETZM CHKTMP
CHKDPL: PUSHJ P,CHKDR1
HRRZ T,(A)
CAIE T,DPLST
JRST CHKDPL
HLRZ T,DPLST
CAIE T,(A)
PUSHJ P,TELLD
POPJ P,
CDDSP: PUSHJ P,TELLD
PUSHJ P,TELLD
JRST CHKDR3
PUSHJ P,TELLD
JFCL
PUSHJ P,TELLD
PUSHJ P,TELLD
PUSHJ P,TELLD
PUSHJ P,TELLD
;CHKDR1 CHKD1A CHKDR2 CDDSP CHKDR3 CHKDR4 CHKD4A
CHKDR1: PUSHJ P,CHKLST
HLRZ T,-1(A)
CAIE T,DIRCOD
PUSHJ P,TELLD
PUSHJ P,CHKDR4
CHKD1A: TLZ E,RPMASK
TDNE E,[-1000]
PUSHJ P,TELLD
MOVEI T,=12(E)
ADDM T,CHKCNT
MOVSI G,440700
HRRI G,LPDESC(A)
CHKDR2: GETCH2 H,G
SOJG E,CHKDR2
PUSHJ P,TELLD
CHKDR3: ILDB C,G
CAIE C,12
PUSHJ P,TELLD
ILDB C,G
CAIN C,177
CAIE E,2
PUSHJ P,TELLD
HRRZ T,-1(A)
ADDI T,-3(A)
CAIE T,(G)
PUSHJ P,TELLD
POPJ P,
CHKDR4: PUSHJ P,CHKD4A
MOVE E,2(A)
JSP B,CHKPNT
D1BIT,,
DIRP1
FIRPAG
TLZN E,DPBIT
POPJ P,
TLNN DSP,D1BIT
PUSHJ P,TELLD
JSP B,CHKPN2
DPBIT,,
DIRPT
CURPAG
POPJ P,
CHKD4A: SKIPN T,1(A)
POPJ P,
ROT T,7
TLZ T,¬177
CAMGE T,CHKTMP
PUSHJ P,TELLD
MOVEM T,CHKTMP
POPJ P,
;CHKLST, CHKFS, CHKFSL, CHKFS2, CHKPNT, CHKPN2
CHKLST: MOVEI B,(A)
HRRZ A,(A)
HLRZ T,(A)
CAIE T,(B)
STOPJ
CHKFS: HRLOI T,-2(A)
MOVEI C,FSPNT
SKIPN B,FSPNT
STOPJ
CHKFSL: CAMG T,(B)
JRST CHKFS2
MOVEI C,(B)
HRRZ B,(B)
JUMPN B,CHKFSL
STOPJ
CHKFS2: HLRZ T,(B)
CAIE T,-1(A)
STOPJ
HRRZ T,(B)
HRRM T,(C)
POPJ P,
CHKPNT: TDZN E,(B)
JRST 3(B)
CHKPN2: CAMN A,@1(B)
TDOE DSP,(B)
STOPJ
MOVEI T,1(D)
CAME T,@2(B)
STOPJ
JRST 3(B)
;CHKPAG, CHKPGP
CHKPAG: MOVEI A,PAGE
SETZM CHKCNT
MOVEI DSP,CPDSP
MOVSI H,NSPEC+LSPC
MOVN D,LINES
JUMPE D,.+3
HRLZ D,D
PUSHJ P,CHKPG1
HRRZ T,(A)
CAIE T,BOTSTR
PUSHJ P,TELLZ
HLRZ T,BOTSTR
CAIE T,(A)
PUSHJ P,TELLZ
MOVEI A,BOTSTR
MOVE E,BOTSTR+TXTFLG
PUSHJ P,CHKPGP
JUMPN E,[PUSHJ P,TELLZ]
SKIPN WINLIN
SKIPL BOTWIN
TLNE DSP,WINBIT
TLNN DSP,ARRBIT
PUSHJ P,TELLZ
MOVE A,CHKCNT
MOVE T,FIRPAG
SOJG T,[AOJA A,.+1]
CAME A,CHARS
PUSHJ P,TELLZ
POPJ P,
CHKPGP: JSP B,CHKPNT
ARRBIT,,
ARRLIN
ARRL
JSP B,CHKPNT
WINBIT,,
WINLIN
TOPWIN
POPJ P,
;CHKPG1, CHKPG2, CPDSP, CHKPGT, CHKPTL
CHKPG1: PUSHJ P,CHKLST
HLRZ T,-1(A)
CAIE T,TXTCOD
PUSHJ P,TELLZ
SKIPGE E,TXTFLG(A) ;Was SKIPGE E,1(A)
PUSHJ P,TELLZ
PUSHJ P,CHKPGP
TLNE E,-1
PUSHJ P,TELLZ
MOVE E,TXTCNT(A) ;New to permit TXTFLG≠TXTCNT
HLRZ T,E
ADDM T,CHKCNT
MOVSI G,440700
HRRI G,LLDESC(A)
MOVEI B,
TRNE E,777777
JRST CHKPG2
ILDB C,G
CAIE C,40
PUSHJ P,TELLZ
CHKPG2: GETCH2 H,G
SUB E,[1,,1]
JUMPLE E,[PUSHJ P,TELLZ]
AOJA B,CHKPG2
CPDSP: PUSHJ P,TELL0
PUSHJ P,TELL1
JRST CHKPG3
PUSHJ P,TELL3
JRST CHKPGT
PUSHJ P,TELL5
PUSHJ P,TELL6
CHKPGT: SUBI E,1000
HRL B,B
TLO B,-10
CHKPTL: ILDB C,G
CAIE C,40
PUSHJ P,TELLZ
SOJLE E,[PUSHJ P,TELLZ]
AOBJN B,CHKPTL
ILDB C,G
CAIE C,11
PUSHJ P,TELLZ
JRST CHKPG2
;CHKPG3, CHKPG4, CHKPG5, CHKPG6
CHKPG3: ILDB C,G
CAIE C,12
PUSHJ P,TELLZ
CHKPG4: TLNN A,760000
JRST CHKPG5
ILDB C,G
JUMPE C,CHKPG4
PUSHJ P,TELLZ
CHKPG5: CAIE E,2000
PUSHJ P,TELLZ
HRRZ T,-1(A)
ADDI T,-3(A)
SKIPGE 1(A)
SUBI T,2
CAIE T,(G)
PUSHJ P,TELLZ
SUBM A,G
MOVSI G,LLDESC-1(G)
HRRI G,LLDESC(A)
MOVEI T,1
CHKPG6: TDNN T,(G)
PUSHJ P,TELLZ
AOBJN G,CHKPG6
AOBJN D,CHKPG1
POPJ P,
;CHKATT, CHKNAT
CHKATT: TRNN F,ATTMOD
JRST CHKNAT
SETZM CHKCNT
MOVEI A,ATTBUF
MOVE DSP,[ARRBIT!WINBIT,,CPDSP]
MOVSI H,NSPEC+LSPC
MOVN D,ATTNUM
JUMPE D,[PUSHJ P,TELLZ]
HRLZ D,D
PUSHJ P,CHKPG1
HRRZ T,(A)
CAIE T,ATTBUF
PUSHJ P,TELLZ
HLRZ T,ATTBUF
CAIE T,(A)
PUSHJ P,TELLZ
MOVE T,CHKCNT
CAME T,ATTSIZ
PUSHJ P,TELLZ
POPJ P,
CHKNAT: SKIPE ATTNUM
PUSHJ P,TELLZ
POPJ P,
IMPURE
SHFMOD: 0
CHKMOD: 0
SAVMOD: 0
PURE
}
;CTAB 0-37
ED←←EDOK*5 EDCMD←←EDOK*7
COMMENT ⊗ CTAB is Fred's clever way of keeping track of the character
flags associated with each character (in the left half-word) and of
providing the relative address of the proper location in the CMDSP
(command dispatch) table, which is accessed by loading the DSP register
with the location of the first entry. CMDSP, in turn, contains, 1)
additional flags in the left half-word (in some cases) that further
delimit the use of the command and 2) addresses in the right half to
the appropiate code. In the case of <cr> the reference is doubly
indirect and CMDSP contains the location of yet another table CRDSP,
which is indexed on B to find still other flags and code locations
for the 4 cases depending on the CONTROL and META bits associated
with the <cr> when used.
Symbols beginning with % (thus %A) are numerically defined in terms
of the location in the CMDSP table of the associated command for the
rest of the symbol (in this case A) so as to identify the command and
its flags. Fred does this with the CC macro in CMDSP on page 16.
Clever!, but confusing until one knows what is happening. ⊗
CTAB: NSPEC,,(DSP) ;NUL 0
ED,,%DA(DSP) ;↓ 1
ED,,7(DSP) ;α 2
ED,,7(DSP) ;β 3
SSP2!ED,,12(DSP) ;∧ 4
SSP1!ED,,13(DSP) ;¬ 5
; ED,,7(DSP) ;ε
ED,,%EPSIL(DSP) ;ε 6
ED,,7(DSP) ;π 7
; ED,,%PI(DSP) ;π 7
; ED,,7(DSP) ;λ
ED,,%LAMBDA(DSP) ;λ 10
LSPC!EDCMD,,4(DSP) ;TAB 11
LSPC,,3(DSP) ;LF 12
%VT(DSP) ;VT (INTEGRAL) 13
SSP1!LSPC,,5(DSP) ;FF 14
SSP1!FSPC!LSPC,,2(DSP) ;CR 15
SSP1!ED,,21(DSP) ;∞ 16
FSPC!ED,,%MSG(DSP) ;∂ 17
SSP1!ED,,14(DSP) ;⊂ 20
SSP2!ED,,15(DSP) ;⊃ 21
ED,,7(DSP) ;∩ 22
ED,,7(DSP) ;∪ 23
NOESS,< SSP1!ED,,16(DSP) ;∀ 24>
ESSAY,< SSP1!ED,,%FRALL(DSP) ;∀>
; ED,,7(DSP) ;∃
ED,,%EXIST(DSP) ;∃ 25
DSPC!ED,,10(DSP) ;⊗ 26
; ED,,7(DSP) ;↔ 27
ED,,%PARB(DSP) ;↔ 27
LT2F!ED,,7(DSP) ;_ 30
; FSPC!ED,,7(DSP) ;→
FSPC!ED,,%RA(DSP) ;→ 31
ED,,7(DSP) ;~ 32
ED,,7(DSP) ;≠ 33
ED,,%LE(DSP) ;≤ 34
ED,,%GE(DSP) ;≥ 35
SSP1!ED,,17(DSP) ;≡ 36
SSP2!ED,,20(DSP) ;∨ 37
;CTAB 40-77
EDCMD,,7(DSP) ;SP 40
ED,,7(DSP) ;! 41
ED,,7(DSP) ;" 42
ED,,7(DSP) ;# 43
LT2F!ED,,7(DSP) ;$ 44
LT2F!ED,,7(DSP) ;% 45
ED,,7(DSP) ;& 46
ED,,7(DSP) ;' 47
FSPC!ED,,%PARL(DSP) ;( 50
; FSPC!ED,,7(DSP) ;( 50
ED,,%PARR(DSP) ;) 51
; ED,,7(DSP) ;*
ED,,%ASTER(DSP) ;* 52
ED,,%PLS(DSP) ;+ 53
FSPC!ED,,7(DSP) ;, 54
ED,,%MIN(DSP) ;- 55
FSPC!ED,,%.(DSP) ;. 56
FSPC!ED,,7(DSP) ;/ 57
NUMF!ED,,11(DSP) ;0 60
NUMF!ED,,11(DSP) ;1 61
NUMF!ED,,11(DSP) ;2 62
NUMF!ED,,11(DSP) ;3 63
NUMF!ED,,11(DSP) ;4 64
NUMF!ED,,11(DSP) ;5 65
NUMF!ED,,11(DSP) ;6 66
NUMF!ED,,11(DSP) ;7 67
NUMF!ED,,11(DSP) ;8 70
NUMF!ED,,11(DSP) ;9 71
FSPC!ED,,%COLON(DSP) ;: 72
FSPC!DSPC!ED,,10(DSP) ;; 73
ED,,%LT(DSP) ;< 74
ED,,7(DSP) ;= 75
ED,,%GT(DSP) ;> 76
; ED,,7(DSP) ;?
ED,,%QUERY(DSP) ;? 77
;CTAB 100-137
ED,,7(DSP) ;@ 100
LETF!ED,,%A(DSP) ;A 101
LETF!ED,,%B(DSP) ;B 102
LETF!ED,,%C(DSP) ;C 103
LETF!EDCMD,,%D(DSP) ;D 104
LETF!ED,,%E(DSP) ;E 105
LETF!ED,,%F(DSP) ;F 106
LETF!ED,,7(DSP) ;G 107
; LETF!ED,,%G(DSP) ;G 107
; LETF!ED,,7(DSP) ;H
LETF!ED,,%H(DSP) ;H 110
LETF!EDCMD,,%I(DSP) ;I 111
LETF!ED,,%J(DSP) ;J 112
LETF!EDCMD,,%K(DSP) ;K 113
LETF!ED,,%L(DSP) ;L 114
LETF!ED,,%M(DSP) ;M 115
LETF!ED,,7(DSP) ;N 116
LETF!ED,,7(DSP) ;O 117
; LETF!ED,,%O(DSP) ;O
LETF!ED,,%P(DSP) ;P 120
LETF!ED,,%Q(DSP) ;Q 121
LETF!EDCMD,,%R(DSP) ;R 122
LETF!EDCMD,,7(DSP) ;S 123
LETF!ED,,%T(DSP) ;T 124
LETF!ED,,%U(DSP) ;U 125
LETF!ED,,%V(DSP) ;V 126
LETF!ED,,%W(DSP) ;W 127
LETF!ED,,%X(DSP) ;X 130
LETF!ED,,%Y(DSP) ;Y 131
LETF!ED,,%Z(DSP) ;Z 132
FSPC!ED,,7(DSP) ;[ 133
; ED,,7(DSP) ;\
FSPC!ED,,%BSLAS(DSP) ;\ 134
FSPC!ED,,7(DSP) ;] 135
ED,,%UA(DSP) ;↑ 136
; FSPC!ED,,7(DSP) ;←
FSPC!ED,,%LA(DSP) ;← 137
;CTAB 140-177
ED,,7(DSP) ;` 140
LETF!LT2F!ED,,%A(DSP) ;a 141
LETF!LT2F!ED,,%B(DSP) ;b 142
LETF!LT2F!ED,,%C(DSP) ;c 143
LETF!LT2F!EDCMD,,%D(DSP) ;d 144
LETF!LT2F!ED,,%E(DSP) ;e 145
LETF!LT2F!ED,,%F(DSP) ;f 146
LETF!LT2F!ED,,7(DSP) ;g 147
; LETF!LT2F!ED,,%G(DSP) ;g
; LETF!LT2F!ED,,7(DSP) ;h
LETF!LT2F!ED,,%H(DSP) ;h 150
LETF!LT2F!EDCMD,,%I(DSP) ;i 151
LETF!LT2F!ED,,%J(DSP) ;j 152
LETF!LT2F!EDCMD,,%K(DSP) ;k 153
LETF!LT2F!ED,,%L(DSP) ;l 154
LETF!LT2F!ED,,%M(DSP) ;m 155
LETF!LT2F!ED,,7(DSP) ;n 156
LETF!LT2F!ED,,7(DSP) ;o 157
; LETF!LT2F!ED,,%O(DSP) ;o
LETF!LT2F!ED,,%P(DSP) ;p 160
LETF!LT2F!ED,,%Q(DSP) ;q 161
LETF!LT2F!EDCMD,,%R(DSP) ;r 162
LETF!LT2F!EDCMD,,7(DSP) ;s 163
LETF!LT2F!ED,,%T(DSP) ;t 164
LETF!LT2F!ED,,%U(DSP) ;u 165
LETF!LT2F!ED,,%V(DSP) ;v 166
LETF!LT2F!ED,,%W(DSP) ;w 167
LETF!LT2F!ED,,%X(DSP) ;x 170
LETF!LT2F!ED,,%Y(DSP) ;y 171
LETF!LT2F!ED,,%Z(DSP) ;z 172
ED,,7(DSP) ;{ 173
SSP1!ED,,22(DSP) ;| 174
LSPC,,6(DSP) ;ALT-MODE 175
ED,,7(DSP) ;} 176
NSPEC,,1(DSP) ;RUBOUT 177
NSPEC,,-1(DSP) ;SEE RDPAG1, also XWRDSP
;GETDIR
GETDIR: MOVEI DSP,GDDSP ;Initial dispatch table on page 113
FOR X IN (DIR,XDIRFG,PAGES,FIRPAG,CURPAG,RLDRUB,SOSBIN#,SOSLIN#,SOSLI2#,SOSPAG#){SETZM X↔}
MOVEI T,XDIRCH
MOVEM T,DIROVH#
MOVEM T,DIRSIZ#
PUSHJ P,ENDSET
MOVSI G,NSPEC+LSPC+NUMF ;For XCT @CTAB(C) on NUL,RUB,CR,LF,TAB,FF,ALT and digits
MOVE H,INPNT
SETZB A,Q
MOVE B,[440700,,[ASCIZ /COMMENT ⊗ xxVALID PAGES/]]
MOVE D,[160700,,Q]
ILDB C,H ;First character
SKIPGE CTAB(C) ;Dispatch on NULL, RUBOUT, 200. Sign bit is NSPEC.
XCT @CTAB(C) ;Special LINE-EDIT case
MOVE T,(H)
AND T,[BYTE (7)160,160,160,160,160(1)1]
CAMN T,[ASCID /00000/]
JRST .+3
CAME T,[ASCID / /]
JRST DIRCL1
HLLOS @SRCFIL+4 ;Signal non-normal directory case
AOJA H,DIRCL
;DIRCL2, DIRCL, DIRCL1, GETDR1
DIRCL2: IDPB C,D
DIRCL: GETCH2 G,H ;Read character (checked for specials and digits)
DIRCL1: ILDB E,B ;Get expected character into E
CAIN C,(E)
JRST DIRCL ;It checks so try next
CAIN E,"x"
JRST DIRCL2
JUMPN E,NODIR ;Jump if didn't match entire expected dir start
MOVEI D,DIR
CAIN Q," "
JRST .+3
CAIE Q,"IN"
JRST NODIR ;Neither " VALID" nor "INVALID" directory
JUMPE A,NODIR ;A contains any number encountered (number of pages)
SKIPE EDFIL-2
SKIPN RDONLY
JRST .+2
JRST IGNDIR ;Ignore old directory in /F mode.
SKIPN @SRCFIL+4 ;Will skip if found SOS line number in directory.
CAIE Q," "
JRST BADDIR ;SOS line numbers or INVALID directory.
SKIPE EDFIL-2 ;Have we flagged the directory for replacement?
JRST DELDIR ;Yes
MOVEM A,PAGES ;Save number of pages indicated by directory.
MOVNI B,(A) ;Now we will read directory lines, one per page.
CAIE C," "
TDZA E,E
MOVE E,[440700,,VBUF]
MOVSI G,LSPC!NSPEC ;For XCT @CTAB(C) ON NULL,RUBOUT,CR,LF,TAB,FF,ALT
MOVNI T,1
JSP TT,LSKP2 ;Get to end of first line, perhaps saving in VBUF.
JUMPE E,GETD1A ;LF will dispatch to here via (TT)
IDPB C,E ;Must have had some version (?) stuff.
MOVEI C,177 ;Marks its end.
IDPB C,E
CAMN E,[100700,,VBUF] ;Skip unless version stuff really not significant.
GETD1A: SETZB T,VBUF
ADDB T,DIROVH ;Count version stuff in directory overhead.
MOVEM T,DIRSIZ
HLRZ T,@SRCFIL+1
CAIN T,'F4 '
SKIPE RDONLY
JRST GETDR1
GETCH2 G,H ;FORTRAN file not in readonly. See if it has C's.
CAIN C,"C"
JRST GETDR1
OUTSTR [ASCIZ /OLD FORMAT DIRECTORY.
REWRITE?/]
PUSHJ P,YESCHK
TRO F,UPDTXT
GETDR1: JSP TT,LSKP1 ;Now skip second line of directory (titles)
MOVE E,FSEND ;Put directory at end of free storage.
MOVEI TT,DIRLF ;Place LF will dispatch for main part of directory.
;DIRLIN DIRLUP DIRDON GDIRX DIRLF DIRLF1 DIRLF2 FINDIR XDRDSP XDIRLN XDIRIL XDCRLF XDIRFF DIRLN2
;The code that actually checks up on the directory page
DIRLIN: GETCH2 G,H ;Skip C (or space) at beginning of dir line
MOVEI A, ;A will hold the collected record number.
MOVSI G,NSPEC+LSPC+NUMF
GETCH2 G,H ;Read record number.
DIRLN2: MOVEI E,1(E)
HRRM E,(D) ;Make previous line/page (or DIR) point to this one.
LEG HRLZM D,(E) ;And store backward pointer.
MOVEI D,(E) ;Advance to the new line/page entry.
LEG MOVEM A,1(D) ;Store record number for page.
ADD E,[440700,,LPDESC] ;Byte pointer for text
MOVSI G,NSPEC+LSPC ;Only specials are NULL,RUB,CR,LF,TAB,FF,ALT
REPEAT 5,{GETCH2 G,H} ;Skip page number (5 digits)
MOVEI Q,1 ;Count char in text, allowing here for the LF
DIRLUP: GETCH2 G,H
LEG IDPB C,E ;Collect text of line
AOJA Q,DIRLUP ; and count length
DIRLF: ;Here from LF at end of directory line.
LEG IDPB C,E ;Put LF into text.
MOVEI C,177 ;Followed by rubout.
LEG IDPB C,E
ADDI E,2
MOVSI T,DIRCOD
FSFIX E,T
HRRZM Q,2(D) ;Store length of text part of directory line.
ADDM Q,DIRSIZ ;And include in directory size.
AOJL B,DIRLIN ;Have we done all pages in directory?
TRNE F,FILLUZ ;Yes
JRST GDIRX
GETCH2 G,H ;Get C for ENDMK line
MOVEM A,LSTPGR# ;Save record # for start of last page
MOVEI A,
MOVSI G,NSPEC+LSPC+NUMF ;Special chars are: NULL,RUB,CR,LF,TAB,FF,ALT,DIGITS
GETCH2 G,H ;Collect record number of ENDMK
MOVEM A,DIREND+1 ; and store it.
MOVSI G,NSPEC ;RUBOUT, NULL
MOVE B,[POINT 7,[ASCIZ/ENDMK
C⊗;
/]]
FINDIR: GETCH2 G,H ;Get char from end of directory
FINDI2: ILDB E,B ;Get expected char
CAIN C,(E) ;Same?
JRST FINDIR ;Yes
CAIN E,"C" ;No. Permitted to differ?
JRST FINDI2 ;Yes, maybe TV file with no "C"
JUMPN E,NODIR ;No, jump if didn't match all the way to end.
CAIE C,14
JRST NODIR ;Directory not followed immediately by FF
MOVE TT,DIR ;Pointer to 1st page
MOVE TT,(TT) ;Pointer to 2nd page
MOVE TT,1(TT) ;Record number where 2nd page is supposed to start.
; ADDI TT,1 ;We should already have read that record
CAMN TT,IBLK ;Reading correct record from file?
CAME H,[POINT 7,IBUF,6] ;And found FF at beginning of that record?
JRST LOSDIR ;No, bad directory.
;Now we have verified that the directory is consistent and ends at the right place.
SOJ A, ;Make it number of last record in file.
SUB A,FILLEN ;Compare reported length and real file length
JUMPGE A,DIRLF1 ;Jump unless the file is longer than expected
;We have just discovered that the file is longer than the directory indicates
;so we will extend the directory (in core only at this point) provided that each
;subsequent FF occurs at the beginning of a record. The updated directory will
;be written out when any page of the file is to be actually written on the disk.
HRLZM A,XDIRFG# ;Remember number of records file had been extended.
SOSG T,PAGES ;Uncount last page. MDFIX will count final pages.
JRST [ AOS PAGES ;Directory said only one page, so don't undo anything
MOVE E,FSEND ;Restore pointer to next block
ADD A,FILLEN ;Get back record number for start of page two.
AOJA A,XDIRNX]
MOVEI E,-1(D) ;Here we must undo the last FSFIX we did just above
MOVEM E,FSEND ;Reset pointers back to beginning of current FS blk
HLRZ D,(D) ;Back up back-pointer to previous blk
MOVN Q,Q
ADDM Q,DIRSIZ ;Uncount last page's directory line
MOVE A,2(E) ;Get record number where last page starts
XDIRNX: HRRM T,XDIRFG ;Remember number of pages file used to have minus 1.
PUSHJ P,SETI ; and start reading file from there to check format
MOVEI DSP,XDRDSP ; new directory entries (lines) for new-found pages
MOVSI G,NSPEC ;RUBOUT and NULL are only specials
MOVE H,INPNT ;Byte pointer set up by SETI
GETCH2 G,H ;First char of page
CAIE C,14 ; better be a Formfeed
JRST UGHDIR ;Directory is useless
MOVSI G,NSPEC!LSPC!DSPC ;Now we check format of remainder of file and create
XDIRLN: MOVEI E,1(E) ;Pointer to forward/back pointers in FS blk
HRRM E,(D) ;Make previous blk point to this new one
LEG HRLZM D,(E) ;And make this one point back to previous one
MOVEI D,(E) ;Advance back pointer to this blk
MOVE T,IBLK ;Record number this page starts
LEG MOVEM T,1(D) ;Store record number in FS blk for this page
ADD E,[350700,,LPDESC] ;Make byte pointer to place for text of dir line
MOVSI T,(<BYTE (7)11>) ;Start dir line with a tab
LEG MOVEM T,(E)
MOVEI B,1 ;Count chars in directory line (already a tab there)
XDIRIL: GETCH2 G,H ;Char from first line of page
LEG IDPB C,E ;Place into directory line
;If we were gonna throw away "COMMENT" and "SUBTTL", we would do it here.
AOJA B,XDIRIL ;Loop till CR, LF, or FF
XDRDSP: JSP C,[JRST -3(C)] ;NULL: Ignore, then get next char
PUSHJ P,RLD ;RUBOUT: Get more text if end of buffer
JUMPGE B,XDCRLF ;CR: Finish directory line if still on it
JUMPGE B,XDCRLF ;LF: Finish directory line if still on it
JFCL ;TAB
JRST XDIRFF ;FF: End of page
MOVEI C,"}" ;ALT
PUSHJ P,TELL7 ;misc not dispatched
JSP C,[JRST -3(C)] ;⊗ or ;--just ignore (don't put in dir line)
XDCRLF: MOVEI C,15
PUSHJ P,MDFIX ;Put CRLF and 177 at end of dir line and do FSFIX
SETO B, ;Flag that we are not now generating dir line
XDCRL2: GETCH2 G,H ;Skip to next FF
JRST XDCRL2
XDIRFF: CAME H,[POINT 7,IBUF,6]
JRST UGHDIR ;FF found not at beginning of record, flush directory
JUMPL B,XDIRF1 ;Jump unless found FF in middle of dir line
MOVEI C,15
PUSHJ P,MDFIX ;Finish up directory line
XDIRF1: TRNN F,EOF ;Was this FF really an EOF?
JRST XDIRLN ;No, go build next directory line
MOVE T,IBLK ;Yes, get record number for ENDMK
MOVEM T,DIREND+1 ; and store it
SOS SPAGE ;Directory page will be added to starting page later
PUSHJ P,GDIRX ;Finish directory and close up FS
TRO F,DIROK ;Directory all ok in core now, but not on disk
TRZ F,FILLUZ ;File formatted.
POPJ P,
DIRLF1: JUMPE A,DIRLF2 ;Jump if file's length is as expected
OUTSTR [ASCIZ /
File is /] ;This should really say "FILENM.EXT[XYZ,ABC] is "...
SETZM TYOPNT
TYPDEC A ;Number of records file is short by.
MOVE A,FILLEN
AOJ A,
MOVEM A,DIREND+1
; PUSHJ P,ENDFIX
; PUSHJ P,FLSDIR
; HRLOM H,@SRCFIL+4
OUTSTR [ASCIZ / records shorter than directory indicates.
Do you want old directory saved as a part of the text? (Y or N) /]
PUSHJ P,YESCHK
JRST NODIR
JRST DELDIR
DIRLF2: SOS SPAGE ;Directory page will be added to starting page later
TRO F,DIROK ;Mark directory in core and ok
SKIPE @DSTFIL+4
TRO F,COPY
GDIRX: MOVEI E,DIREND
HRRM E,(D) ;Make last line/page entry point to ENDMK entry
HRLZM D,DIREND ;And vice versa backwards
PUSHJ P,ENDFIX ;Finish off free storage used for directory
MOVE T,PAGES
IMULI T,=12 ;Chars/line for C00001 00001 stuff on directory.
ADDB T,DIRSIZ ;Include in size of directory.
MOVEM T,ODSIZ#
SETZM DIREND+2
POPJ P,
;LOSDIR BADDIR BADDI2 NODIR DIRNUM GDDSP LSKP1 DIRSHF DIREND UGHDIR FLSDIR IGNDIR DELDIR
IGNDIR: OUTSTR [ASCIZ /
New directory is on page 0. Do not use old INVALID directory starting on page 1./]
HRLOM H,@SRCFIL+4
JRST DELDIR ;Must delete old directory
UGHDIR: MOVEI T,[ASCIZ/
File is longer than Directory indicates and extended part of file is
not properly formatted. File must be reformatted/]
SETZM XDIRFG ;Did not extend old directory after all.
MOVEI DSP,RPDSP ;Restore usual dispatch table for return to DIRLN2
JRST BADDI2
LOSDIR: SKIPN PAGES
JRST NODIR
REPEAT 0,< ;Flushed because this generated FS lossage!
PUSHJ P,ENDFIX
PUSHJ P,FLSDIR
>;REPEAT 0
SKIPA T,[[ASCIZ /
DIRECTORY IS GARBLED/]]
BADDIR: MOVEI T,[ASCIZ /
Invalid or undesired directory/]
BADDI2: SKIPE QUIETF
JRST DELDIR
OUTSTR (T)
HRLOM H,@SRCFIL+4
SKIPN RDONLY
JRST .+3
OUTSTR [ASCIZ /.
Old directory kept as part of text.
/]
JRST NODIR
OUTSTR [ASCIZ /.
KEEP OLD DIRECTORY AS PART OF TEXT?/]
PUSHJ P,YESCHK
JRST NODIR
DELDIR: SETOM @SRCFIL+4
SOS SPAGE ;Directory page will be added to starting page later.
SKIPE EDFIL-2
SKIPN RDONLY
JRST .+2
JRST .+3 ;Special case with no COPY
;**** MAYBE ABOVE SHOULD BE +2
TROA F,COPY
NODIR: HLLOS @SRCFIL+4
MOVEI D,DIR
SETZM DIREND+1
TRO F,FILLUZ
TRZ F,UPDTXT
SKIPN RDONLY
TROA F,COPY
SKIPE DIR
JRST GDIRX
AOS PAGES
MOVE E,FSEND
MOVEI A,1
MOVEI B,
MOVEI TT,DIRLF
MOVE H,[440700,,[ASCII /XXXXX
/]]
JRST DIRLN2
FLSDIR: SETZM PAGES
SKIPN A,DIR
POPJ P,
TLO F,NOCHK ;Added by ALS
FLSDI2: HRRZ B,(A)
CAIE A,DIREND
PUSHJ P,FSGIVE
SKIPE A,B
JRST FLSDI2
TLZ F,NOCHK ;Added by ALS
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
SETZM DIR
POPJ P,
DIRNUM: IMULI A,12
ADDI A,-"0"(C)
JRST -3(T)
;THIS IS THE DISPATCH TABLE (DSP) USED BY GETDIR. REFERENCED BY XCT @CTAB(C)
GDDSP: JSP C,[JRST -3(C)] ;null, just ignore
PUSHJ P,RLD ;rubout, maybe get more text
JFCL ;CR
JRST (TT) ;LF -- main character treated specially here
JFCL ;TAB
JRST LOSDIR ;FF in middle of directory is quite improper.
MOVEI C,"}" ;ALTMODE
PUSHJ P,TELL7 ;misc -- not dispatched on
PUSHJ P,TELL8 ;⊗ or ; -- not dispatched on
JSP T,DIRNUM ;digit -- add in to previous total and get next char
LSKP1: GETCH2 G,H
GETCH2 G,H
JRST LSKP1
LSKP2A: GETCH2 G,H
LSKP2: IDPB C,E
AOJA T,LSKP2A
DIRSHF: PUSHJ P,LSTSHF
SKIPGE T,3(A)
ADDM C,DIRPT
TLNE T,D1BIT
ADDM C,DIRP1
POPJ P,
IMPURE
DIREND: BLOCK LPDESC
PURE
;COPFIL, COPFL1, COPDO, COPYX, COPDAT, COPLUP
COPFIL: TRZN F,COPY
POPJ P,
TLZ F,TF1
MOVE A,@DSTFIL
MOVE B,@DSTFIL-1
CAMN B,@SRCFIL-1 ;Compare source and dest devices
CAME A,@SRCFIL ; and file names
JRST COPFL0 ;Different device or different file name
HLRZ B,@SRCFIL+1
HLRZ C,@DSTFIL+1
MOVE A,@DSTFIL+3
CAIN B,(C) ;Compare source and dest extensions
CAME A,@SRCFIL+3 ; and PPNs
COPFL0: PUSHJ P,COPCHK ;Dest file not same as source file. Does dest already exist?
MOVE T,@SRCFIL+2
MOVEM T,@DSTFIL+2 ;Copy PROTECTION, mode, time/date to new file
HRRZ T,@SRCFIL+1
HRRM T,@DSTFIL+1 ;Copy high-order part of date to new file
MOVEI E,@DSTFIL
PUSHJ P,OPENO
SKIPN @SRCFIL+4
SKIPE @DSTFIL+4
JRST FORMAT
MOVEI A,1
COPFL1: PUSHJ P,SETI
PUSHJ P,COPCOR
MOVS A,LKUP+3
COPDO: PUSHJ P,COPDAT
COPYX: CLOSE DSKO,
RELEAS DSKO, ;SHIT-EATING SYSTEM!
SETZM JOBJDA+DSKO
MOVE A,FSMAX
SUBI A,1
CORE A,
PUSHJ P,TELLZ
POPJ P,
COPDAT: JUMPGE A,CPOPJ
DPB A,[221200+COPNUM*100,,COPCM2]
ASH A,-12-COPNUM
AOJGE A,COPDA3 ;Jump if have 8K or less stuff to copy
COPLUP: INPUT DSKI,COPCMD
OUTPUT DSKO,COPCMD
AOJL A,COPLUP
COPDA3: INPUT DSKI,COPCM2 ;Get final partial buffer
MOVE A,COPCM2
TLZN A,1 ;Don't lose low-order 4 bits of odd dmp wd
JRST COPDA4 ;Even word count--no problem
MOVEM A,COPCM2 ;Output an extra word
HLRZ B,A
SUBI A,(B)
SETZM (A) ;Make sure extra word is zero
COPDA4: OUTPUT DSKO,COPCM2
POPJ P,
;COPCOR, COPCHK, YESCHK, COPCMD
COPCOR: MOVE T,JOBREL
HRRM T,COPCMD
HRRM T,COPCM2
ADDI T,2000⊗COPNUM
CORE T,
PUSHJ P,TELLZ
POPJ P,
COPCHK: TLO F,TF1
SKIPE QUIETF
POPJ P,
MOVSI T,@DSTFIL
ADD T,[-1,,ENTR-1]
MOVEI C,DSKO
PUSHJ P,OPNDEV ;skips on failure
LOOKUP DSKO,ENTR
JRST COPCH2 ;Make sure we got the NO-SUCH-FILE error
CLOSE DSKO,
OUTSTR [ASCIZ/FILE ALREADY EXISTS: /]
MOVEI D,@DSTFIL
PUSHJ P,FILTYP
OUTSTR [ASCIZ/
REPLACE?/]
PUSHJ P,YESCHK
POPJ P,
JRST FNF2
COPCH2: HRRZ TT,ENTR+1 ;Get error code
JUMPE TT,CPOPJ ;No such file
MOVEI D,ENTR
PUSHJ P,FILERR ;Tell him of strange error
JRST FNF1 ;Give up and ask for new file name
;First return on Y or y, second return on anything else
YESCHK: CLRBFI
PUSH P,C ;Save C so this will be safe to use anywhere
PUSHJ P,CTYI2 ;Read single char from TTY
CAIE C,15
OUTSTR [ASCIZ/
/]
MOVEM C,YESAVE# ;Save answer to yes or no question
CAIE C,"Y"
CAIN C,"y"
JRST POPCJ ;He said yes, take direct return.
POP P,C
AOS (P)
JRST MACSTP ;Terminate macro expansion.
IMPURE
COPCMD: -2000⊗COPNUM,,
0
COPCM2: -2000⊗COPNUM,, ;For final (partial) buffer
0
PURE
;FORMAT FMTOK FMTDSP FORMT2 FORMT3 FORMT4 FORMT5 FORMT6
FORMAT: TLNN F,TF1
SKIPE QUIETF
JRST FMTOK
SKIPE EDFIL-2
JRST [ OUTSTR [ASCIZ /VERIFYING /]
JRST FORMT3]
HLLZ T,@SRCFIL+4
XOR A,RPPN
TRNN A,-1
JUMPN T,FMTOK
FORMT2: SKIPE CREASW
JRST FMTOK
FORMT3: OUTSTR [ASCIZ /NEED TO REFORMAT /]
MOVEI D,@DSTFIL
PUSHJ P,FILTYP
OUTSTR [ASCIZ /. OK?/]
PUSHJ P,YESCHK
JRST FMTOK
FORMT4: MOVE A,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
RELEAS DSKO,1 ;Inhibit closing this open file
CLOSE DSKI, ;but close this one
SETZM DIR
MOVE A,YESAVE#
CAIN A,175
JRST FNF2 ;Altmode gets you out of here quick
OUTSTR [ASCIZ /Would you settle for READONLY? (Y or N) /]
PUSHJ P,YESCHK
JRST FORMT5
MOVE A,YESAVE
CAIN A,175
JRST FNF2 ;Altmode gets you out of here quick
OUTSTR [ASCIZ ⊗Would you settle for /N (no directory) mode? (Y or N) ⊗]
PUSHJ P,YESCHK
JRST FORMT6
JRST FNF2 ;No, let him type another filename
FORMT5: SETOM RDONLY ;Give him /R mode
SETZM EDFIL+4 ;and don't give him /N
TROA F,REDNLY
FORMT6: HRLOM A,EDFIL+4 ;Give him /N mode
SUB P,[1,,1]
JRST BEG4
FMTOK: PUSHJ P,CORCHK ;To simplify recovery if formatting is aborted
MOVEI A,1
SETZM RLDFLG ;Used to limit repeating formatting check
PUSHJ P,SETI
MOVE A,@SRCFIL+4
ROT A,1
ANDI A,3
MOVE T,TRMCHR
CAIE T,"→"
XCT FMTDSP(A)
OUTSTR [ASCIZ /REQUESTED FORMAT CHANGE MODE NOT IMPLEMENTED.
/]
JRST GETOU1
FMTDSP: JFCL
PUSHJ P,TELLZ
JRST MAKDIR
JRST NEWDIR
;NEWDIR, NEWDLP, SKPDSP, NEWDFF, OPUT, OSET, TMPDIR
NEWDIR: MOVEI DSP,SKPDSP
MOVSI H,LSPC+NSPEC
MOVE G,INPNT
NEWDLP: GETCH2 H,G
GETCH2 H,G
JRST NEWDLP
SKPDSP: JSP C,RDLNUL
PUSHJ P,RLD
JRST NEWDLP
JRST NEWDLP
JRST NEWDLP
JRST NEWDFF
JRST NEWDLP
NEWDFF: SKIPE @DSTFIL+4
JRST MAKDR0
SKIPA T,IBLK
PUSHJ P,WRBUF
SOJG T,.-1
JRST MAKDR0
OPUT: PUSHJ P,WRBUF
OSET: MOVN A,OCNT
HRLI B,(A)
MOVE A,OPNT
POPJ P,
;MAKDIR, MAKDR0, MAKDR1, MAKDOL, MDOL1
MAKDIR: MOVE G,INPNT
MOVEI C,14
MAKDR0: PUSHJ P,FLSDIR
SKIPE @DSTFIL+4
JRST MAKDR1
MOVE T,[DIR,,DIREND]
PUSHJ P,DIRAD1
MOVNI T,=12
ADDM T,DIRSIZ ;DON'T COUNT THIS TWICE
MOVEI T,1
MOVEM T,1(A)
SKIPA D,A
MAKDR1: MOVEI D,DIR
PUSHJ P,ENDSET
MOVE E,FSEND
MAKDOL: PUSHJ P,OSET
HRRI B,
SKIPN PAGES
JRST MDOL1
IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
MDOL1: MOVEI E,1(E)
HRRM E,(D)
LEG HRLZM D,(E)
MOVEI D,(E)
MOVE T,OBLK
LEG MOVEM T,1(D)
ADD E,[350700,,LPDESC]
MOVSI T,(<BYTE (7)11>)
LEG MOVEM T,(E)
HRRI B,1
MOVSI H,LSPC+DSPC+NSPEC
MOVEI DSP,MD1DSP ;Dispatch table on page 119
MOVE T,[440700,,T]
MOVEM T,INPNT
SETZM FFLINE# ;Count lines on this page for /F.
SETZB T,TT
JSP Q,SOSCHK
;MDIL1, MDIL1A, MDIL2, MDIL2A, MDCSRC, MDCSR1, MD1DSP
MDIL1: GETCH2 H,G
IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
LEG IDPB C,E
CAIL C,140
SUBI C,40
IDPB C,INPNT
CAIG C,40
JRST MDCSRC
; TRNN B,-10 ;REPLACED BY
; JRST MDIL1 ; " "
PUSH P,C ;YOU HAVE ANOTHER AC? THEN WE CAN TALK.
HRRZ C,B ;THIS ALL MAKES SURE SYMBOL IS SHORT ENUF, THEN COMPARES AGAINST
CAIG C,10 ;A LIST OF "COMMENT" AND "SUBTTL" TO REMOVE THEM FROM DIR PAGE.
JRST [ POP P,C ↔ JRST MDIL1 ]
POP P,C
MDIL1A: MOVEI DSP,MD2DSP ;Also set to this table on page 118
MOVEI T,MD2CR
MOVEM T,INPNT
MDIL2: GETCH2 H,G
LEG IDPB C,E
MDIL2A: IDPB C,A
AOBJN B,MDIL2
PUSHJ P,OPUT
JRST MDIL2
MDCSRC: PUSHJ P,MDCSR1
JUMPGE DSP,MDIL1A
MOVSI E,350700
HRRI E,LPDESC(D)
HRRI B,400001
JRST MDIL1A
MDCSR1: MOVSI DSP,-NSCOMS
DPB DSP,INPNT
CAMN T,SCOMS(DSP)
CAME TT,SCOMS2(DSP)
AOBJN DSP,.-2
POPJ P,
MD1DSP: JSP C,RDLNUL
PUSHJ P,RLD
JRST MD1CR
JRST MAKDLF
JFCL
JRST MDFF1
MOVEI C,"}"
PUSHJ P,TELL7
JRST MDIL1B
;MDIL1B MAKDLF MAKDFF MDFF1 MDFF2 MDFF3 MDFF4 MDCEOL MD2DSP RLDCHK RLDCK1 RLDCK2 RLDCK3 RLDCKX
MDIL1B: IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
SOJA B,MDIL1
MAKDFF: TRNN B,-2
JRST MDFF2
MAKDLF: ADD G,[70000,,]
MOVEI C,15
JRST @2(DSP)
MDFF1: TRNE B,-2
JRST MAKDLF
MOVEI C,15
PUSHJ P,MDFIX
MDFF4: MOVEI C,14
MDFF2:
;Here we check to see if it is indeed safe to reformat the file
TRNN F,REDNLY ;Are we in read only
SKIPE RLDFLG# ;Has the test been made yet
JRST .+2 ;Yes
PUSHJ P,RLDCHK ;No, so make test
JUMPE A,MDFF3
MOVEM A,OPNT
MOVE A,D
PUSHJ P,CLOSO
MOVE D,A
MDFF3: TRNN F,EOF
JRST MAKDOL
MOVE T,OBLK
MOVEM T,DIREND+1
PUSHJ P,GDIRX
TRO F,DIROK
TRZ F,FILLUZ
SKIPN @DSTFIL+4
TRO F,UPDTXT
JRST COPYX
MDCEOL: PUSHJ P,MDCSR1
TRNE B,-2
JUMPGE DSP,CPOPJ
MOVSI E,440700
HRRI E,LPDESC(D)
HRRI B,
POPJ P,
MD2DSP: JSP C,RDLNUL ;DSP set for this dispatch table on page 121
PUSHJ P,RLD
JRST @INPNT
JRST MAKDLF
JFCL
JRST MAKDFF
MOVEI C,"}"
PUSHJ P,TELL7
SOJA B,MDIL2A
;Here we check to see if it is really safe to complete the formatting of the
;file being loaded.
RLDCHK: SETZM TYOPNT ;Test last time always
MOVE T,RLDRUB
JUMPN T,RLDCK2
SKIPN T,SOSBIN
POPJ P, ;Seems to be a normal source file
SETOM RLDFLG ;Inhibit further questions
SUB T,SOSPAG
SUB T,SOSLIN
JUMPN T,RLDCK2 ;Not a simple SOS file
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /You are formatting an SOS file.
/]
RLDCK1: HRRZ T,EDFIL+3 ;Get file PN
SKIPN T ;If no PPN check alias
HRRZ T,PPN
PUSH P,A
HRRZ A,RPPN ;Check with users name
CAME T,A
JRST .+3 ;Ask a question
POP P,A
POPJ P, ;OK
OUTSTR [ASCIZ /Are you sure that /]
PUSH P,B
PUSH P,C
HRLZ A,T
PUSHJ P,PNTYO
POP P,C
POP P,B
POP P,A
OUTSTR [ASCIZ / will approve? (Y or N) /]
PUSHJ P,YESCHK
POPJ P,
RLDCKX: MOVE P,[-70,,PDL]
PUSHJ P,ENDFIX
PUSHJ P,FLSDIR
JRST FORMT4
RLDCK2: SETOM RLDFLG
MOVE T,SOSLI2
JUMPN T,RLDCK3
SKIPN RLDRUB
POPJ P,
OUTSTR [ASCIZ /
This file has several special symbols and is probably an XGP or binary file.
Do you really want to garbage it? (Y or N) /]
SKIPA
RLDCK3: OUTSTR [ASCIZ /
This may be a binary file that would be hopelessly garbaged by formatting.
Do you really want to format it (Y or N)? /]
SETOM RLDFLG
PUSHJ P,YESCHK
JRST RLDCK1
JRST RLDCKX
;MD1CR, MD2CR, MD3CR, MD3CR1, MDIL3, MDCRCK, MDFIX, MDLFCK
MD1CR: IBP INPNT
PUSHJ P,MDCEOL
MD2CR: PUSHJ P,MDFIX
MOVSI H,LSPC+NSPEC
MOVEI T,MD3CR
MOVEM T,INPNT
MD3CR: IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
MOVEI C,12
IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
HRRI B,1
SKIPE EDFIL-2 ;Are we inserting FFs for /F mode?
JRST MD4CR
MD4CR0: SKIPA DSP,[MDCRCK] ;Table below
MD3CR0: MOVEI DSP,MD2DSP ;Table on page 120
MD3CR1: GETCH2 H,G
MOVEI DSP,MD2DSP
JSP Q,SOSCK2
MDIL3: GETCH2 H,G
IDPB C,A
AOBJN B,MDIL3
PUSHJ P,OPUT
JRST MDIL3
MD4CR: AOS DSP,FFLINE ;Count another line on this page.
CAMGE DSP,EDFIL-2 ;Time to insert another FF?
JRST MD4CR0 ;No.
MOVEI DSP,MDLFCK
GETCH2 H,G
CAIE C,12 ;Is this the LF we expected?
JRST MD5CR
GETCH2 H,G ;Get first character following the CRLF.
MD5CR: ADD G,[070000,,0] ;Back up byte pointer to save char for next time.
JRST MDFF4 ;Go insert FF.
MDLFCK: JSP C,RDLNUL
PUSHJ P,RLD
JFCL
JFCL ;LF
JFCL
JRST MDFF2 ;Got a real FF.
MOVEI C,"}"
MDCRCK: JSP C,RDLNUL
PUSHJ P,RLD
JRST MD3CR1
JRST MD3CR0
JFCL
JRST MDFF2
MOVEI C,"}"
MDFIX: MOVEI T,12
LEG IDPB C,E
LEG IDPB T,E
MOVEI T,177
LEG IDPB T,E
ADDI E,2
MOVSI T,DIRCOD
FSFIX E,T
LDB T,[2100,,B]
ADDI T,2
MOVEM T,2(D)
ADDM T,DIRSIZ
AOS PAGES
POPJ P,
;CREATE, CREAT2, CTEXT
CREATE: TRZ F,COPY
SKIPN @DSTFIL
JRST FLOSE
PUSHJ P,COPCHK
; LDB T,[1400,,DATBLK] ;MUST FIX ******
; HRRM T,@DSTFIL+1
; LDB T,[POINT 12,DATBLK,17]
; DPB T,[POINT 12,@DSTFIL+2,35]
; LDB T,[POINT 3,DATBLK,5]
; DPB T,[POINT 3,@DSTFIL+1,20]
HLLZS @DSTFIL+1 ;Zero entire right half first
LDB T,[POINT 12,DATBLK,17] ;Now get date
DPB T,[POINT 12,@DSTFIL+1,35] ;and put it in right half
LDB T,[POINT 15,DATBLK,17] ;Now get date
DPB T,[POINT 15,@DSTFIL+1,35] ;and put it in right half
MOVEI E,@DSTFIL
PUSHJ P,OPENO
SKIPE @DSTFIL+4
JRST CREAT2
MOVE A,[CTEXT,,OBUF]
BLT A,OBUF+LCTEXT-1
SETZM OBUF+LCTEXT
MOVE A,[OBUF+LCTEXT,,OBUF+LCTEXT+1]
BLT A,OBUF+377
MOVSI A,(<BYTE(7)14>)
MOVEM A,OBUF+200
OUTPUT DSKO,[-400,,OBUF-1↔0]
CREAT2: CLOSE DSKO,
MOVE A,[DSTFIL,,SRCFIL]
BLT A,SRCFIL+4
POPJ P,
CTEXT: ASCII/COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00003 ENDMK
C⊗;
/
LCTEXT←←.-CTEXT
;RDSPA1 RDPAGE RDPGOK RDSPAG RDPAG0 RDSPA2 RDSPA4 RDSPA5
;Fixes up page info for the header line
;RDSPA1: SKIPA T,FIRPAG
RDSPA2: MOVEI T,(A) ;Start with the page number
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,HEDPAG ;Put it on asterisk heading line
MOVEM C,HED2PG ;and also on dash heading line
; MOVEM C,BOTPG2 ;Deposit the page number
; MOVEM C,BOTPG4 ;on both asterisk and dash bottom lines
POPJ P,
RDSPA4: MOVE T,CURPAG
CAME T,FIRPAG ;Only one page in core?
JRST RDSPA5 ;No
MOVSI T,(<ASCII/ />)
HLLM T,HED3PG
HLLM T,HED4PG
MOVEI T,1 ;Make header say "PAGE X"
MOVEM T,HED5PG
MOVEM T,HED5PG+1
MOVEM T,HED6PG
MOVEM T,HED6PG+1
POPJ P,
RDSPA5: PUSHJ P,NUMSTD ;Convert number of final page in core to ASCID
MOVEM C,HED5PG+1
MOVEM C,HED6PG+1
MOVSI T,(<ASCII/:/>)
HLLM T,HED5PG
HLLM T,HED6PG
MOVSI T,(<ASCII/S />) ;Make header say "PAGES X:Y"
HLLM T,HED3PG
HLLM T,HED4PG
POPJ P,
;Note skip return
RDPAGE: TRZ F,UPDIR+WRITE+XPAGE+EDDIR
SETZM FFLINE ;Used only with /F switch
MOVE B,A
CAMGE A,DIRPAG
HRRO A,DIRPAG
CAMLE A,PAGES
HRRO A,PAGES
JUMPL A,RDPGLZ
AOS (P)
RDPGOK: CAMN A,FIRPAG
JRST RDSPAG
PUSHJ P,FNDPAG
JUMPN T,.+2
MOVEI T,DIR
MOVSI TT,D1BIT
IORM TT,2(T)
EXCH T,DIRP1#
JUMPE T,.+2
ANDCAM TT,2(T)
HRRZM A,FIRPAG
RDSPAG: PUSHJ P,RDSPA2 ;Update page info for header line
PUSHJ P,CLRWR2
SETZM CHARS#
SETZM ROOM
SETZM RELPGN
MOVE A,FIRPAG
RDPAG0: SETZM LINES
TRNE A,-2
AOS CHARS ;FF ON MOST PAGES
MOVE B,A
PUSHJ P,FNDPAG
MOVEM A,CURPAG
PUSH P,T
PUSHJ P,RDSPA4 ;Update CURPAG entry on header
POP P,T
MOVE D,T
EXCH T,DIRPT#
MOVSI TT,DPBIT
JUMPE T,.+2
ANDCAM TT,2(T)
IORM TT,2(D)
AOS TT,RELPGN#
DPB TT,[RPBYTE+2(D)]
MOVEI G,RLD ;Using G here ensures that GETCHR on next page won't
MOVEM G,RLDA# ; screw up on nulls because RDLNUL thinks G is byte pointer
CAMN B,DIRPAG
JRST DRGSET
JUMPE B,CPOPJ
CAMLE B,PAGES
POPJ P,
MOVEI DSP,RPDSP
SKIPN A,1(D)
PUSHJ P,TELLZ
PUSHJ P,SETI
;RDPAG2 RDPAG1 RDLINE RDLLP RDLTAB TELLD1 TELLDZ PSEUDO
TRNE F,FILLUZ
SKIPA T,[JSP Q,SOSTST]
RDPAG2: MOVE T,[SETZB B,TT]
MOVEM T,RDLINS#
HRRZ T,(D)
HRRZ T,1(T)
SUBI T,(A)
IMULI T,200*5
ADDM T,ROOM#
CAIG B,1
JRST RDPAG1
GETCHR
CAIE C,14
PUSHJ P,TELLD1 ;In /R/F mode TELLD1 fixes things. Otherwise, error.
RDPAG1: MOVSI H,LSPC+NSPEC
PUSHJ P,ENDSET
AOS T,A ;MAKE T +
MOVE G,INPNT
MOVEI D,PAGE#
MOVSI E,440700
HRRI E,LLDESC(A) ;SET UP FOR SSET2
ILDB C,G
SKIPGE CTAB(C)
XCT @CTAB(C)
DPB C,G ;IN CASE CLOBBERED BY SSET
ADD G,[70000,,]
CAIE C,12
JRST RDLINE
MOVEM G,NEWPNT
SOS IBLK
MOVE G,[441100,,[BYTE (9)15,200]]
RDLINE: HRRM A,(D)
LEG HRLZM D,(A)
RDLIN2: MOVSI E,440700
HRRI E,LLDESC(A)
XCT RDLINS ;SETZB B,TT OR JSP Q,SOSTST
RDLLP: GETCH2 H,G
RDLLP2:
LEG IDPB C,E
AOJA B,RDLLP
RDLTAB:
LEG IDPB C,E
HRROI D,-10
IORI D,(B)
SUB B,D
ADDI TT,(D)
MOVEI T,40
JRST .+11(D)
REPEAT 10,<LEG IDPB T,E>
LEG IDPB C,E
AOJA TT,RDLLP
PSEUDO: CAIN C,12 ;Was this the char causing a pseudo FF insertion?
POPJ P, ;Yes
MOVE C,[070000,,0] ;No, back up pointer over this real character
ADDM C,INPNT
POPJ P,
TELLD1: SKIPE EDFIL-2
JRST PSEUDO ;No error if in /F/R
PUSHJ P,TELLDZ
ASCIZ /
DIRECTORY POINTER INVALID (NO PAGE MARK HERE) -- PROCEED WITH CAUTION
/
TELLDZ: POP P,40
OUTSTR @40
SETOM TELFL2
TRNE F,REDNLY
POPJ P, ;Don't tellme if in readonly
PUSHJ P,FBI
JRST MACSTP ;Terminate macro expansion.
;RDLCR RDLLF RDLONG RDLCR2 RDLCR1 RDLCR0
RDLCR0: ADD G,[70000,,]
RDLCR1: MOVEI C,15 ;Long line code on page 124 enters here
RDLCR: HRROI T,40
JUMPN B,.+2
LEG IDPB T,E
LEG IDPB C,E
GETCH2 H,G
RDLCR2: ADD G,[70000,,]
MOVEI C,12
RDLLF: JUMPGE T,RDLCR0
LEG IDPB C,E
TDZA C,C
LEG IDPB C,E
TLNE E,760000
JRST .-2
CAIL B,377776 ;Was CAIL B,1000-2
JRST RDLONG
AOS LINES
ADDI TT,2(B)
ADDM TT,CHARS
HRL B,TT
MOVEM B,TXTCNT(A)
HRRZS TXTFLG(A) ;Was formerly handled by HRRZM in previous line
AOS T,TXTNUM#
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
MOVEI D,(A)
MOVNI E,1(E)
ADDI E,LLDESC(A)
HRLI A,(E)
ADDI A,LLDESC+1
MOVEI T,1
IORM T,-1(A)
AOBJN A,.-1
MOVSI T,TXTCOD
FSFIX A,T
AOJA A,RDLINE
RDLONG: MOVE T,LLDESC(A)
CAME T,[ASCII /βββββ/]
CAMN T,[ASCID /βββββ/]
JRST RDLIN2
FATAL LINE MORE THAN 131070 CHARS
;RDLFF RDLDON LINSET RPDSP RDLNUL LINSE2
RDLFF: JUMPN B,RDLFF2
RDLDON: HRRZS CHARS
PUSHJ P,ENDFIX
HRLM D,BOTSTR
MOVEI T,BOTSTR
HRRM T,(D)
MOVEM G,INPNT
TRNN F,EDDIR
PUSHJ P,DIRCHK
TRNE F,FILLUZ
PUSHJ P,INSDIR
LINSE2: TLO F,DSPTRL ;Force recalculation of trailer values
LINSET: MOVE T,LINES
CAMGE T,ARRL
TLOA F,OFFEND
TLZ F,OFFEND
SUB T,SCRSIZ
ADDI T,3
ADD T,EXTRA
JUMPG T,.+3
MOVEI T,1
SETOM BOTWIN
EXCH T,WINMAX#
CAMN T,WINMAX
CAIG T,1
SETOM BOTWIN
POPJ P,
RDLFF2: MOVEI C,15 ;Here with FF in middle of line--insert CRLF
LEG IDPB C,E
SETO T, ;Flag that we already have a CR for the following LF
JRST RDLCR2 ;Now put in the LF
;Dispatch table
PUSHJ P,RLD1
RPDSP: JSP C,RDLNUL ;NULL
PUSHJ P,@RLDA ;RUBOUT
JUMPGE T,RDLCR ;CR
JRST RDLLF ;LF
JUMPGE T,RDLTAB ;TAB
JUMPGE T,RDLFF ;FF
MOVEI C,"}" ;ALTMODE
repeat 1,<
;Dispatch table to test the characters after finding a pseudp FF position
PUSHJ P,RLD1
RPDSP2: JSP C,RDLNUL ;NULL
PUSHJ P,@RLDA ;RUBOUT
JFCL ;CR
JFCL ;LF
JFCL ;TAB
JUMPGE T,SOSTS2 ;A real FF here so restore DSP and proceed normally
MOVEI C,"}" ;ALTMODE
>
RDLNUL: SKIPE (G)
JRST -3(C)
HRLI G,700
SKIPN 1(G)
AOJA G,.-1
JRST -3(C)
;RDPGLZ, SOSTST, SOSCHK, SOSCK2, PGMK, PGMK2
RDPGLZ: ANDI A,-1
TRNE F,DIROK
JRST RDPGOK
PUSH P,B
PUSHJ P,RDPGOK
PUSHJ P,FLSPAG
POP P,A
JRST RDPAGE
SOSTST: SETZB B,TT
AOS C,FFLINE ;Get updated line count
SKIPE EDFIL-2 ;Are we in /F mode?
CAMG C,EDFIL-2 ;Are there enough lines on this page?
JRST SOSCHK ;not time for pseudo FF
SETZM FFLINE
MOVEI DSP,RPDSP2 ;Special dispatch table on page 126
GETCH2 H,G
MOVEI C,14
ADD G,[70000,,0]
JUMPGE G,.+2
SUB G,[430000,,1]
SOSTS2: SKIPA DSP,[RPDSP] ;Reset usual dispatch but don't pick up character.
;The above SKIPA skips over the first instruction GETCH2 expands to (ILDB C,G).
SOSCHK: GETCH2 H,G
SOSCK2: PUSH P,T
MOVEI T,1
AOS SOSBIN ;To count total references to SOSCK2
TDNN T,(G)
JRST [ POP P,T ↔ JRST 3(Q)]
POP P,T
MOVE C,(G)
CAMN C,[ASCID / /]
JRST PGMK
AND C,[BYTE (7)160,160,160,160,160(1)1]
CAME C,[ASCID /00000/]
JRST [AOS SOSLI2↔JRST 2,@[20000,,(Q)]]
AOS SOSLIN
AOJA G,.+2
IBP G
SKIPGE (G)
PUSHJ P,RLD
JRST (Q)
PGMK: HRLI G,10700
AOS SOSPAG ;To count SOS pages
SKIPGE (G)
PUSHJ P,RLD
PGMK2: ILDB C,G
CAIN C,14
JRST @5(DSP)
CAIN C,15
JRST PGMK2
JRST 1(Q)
;DIRCHK DIRNEW DIRNW2 DIRNW1 TXTSHF
DIRCHK: MOVE A,INPNT
SUB A,IBFPNT
ADD A,[70000,,]
JUMPGE A,.+2
SUB A,[XOR 1]
ROT A,-7
HRR A,IBLK
HRRZ E,@DIRPT
SKIPN 1(E)
JRST DIRNEW
CAME A,1(E)
PUSHJ P,TELLD2
POPJ P,
TELLD2: PUSHJ P,TELLDZ ;On page 124, reports message, calls FBI, pops back above
ASCIZ /
** DIRECTORY TROUBLE! ** If wrong page shows, DO NOT edit this page.
Give command to switch to page number shown at top.
/
DIRNEW: TRNN F,EOF
JRST DIRNW1
TRO F,DIROK
TLO F,DSPTRL ;Force recalculation of trailer values
SETOM DPAGES ;Force redisplay of total number of pages
DIRNW2: MOVEM A,1(E)
POPJ P,
DIRNW1: MOVE T,DIRPT
CAIE E,DIREND
JRST DIRNW2
PUSHJ P,DIRADD
JRST DIRCHK
TXTSHF: PUSHJ P,LSTSHF
HLLZ T,TXTFLG+1(A) ;Was MOVE T,2(A) ;A points to FS word
TLNE T,ARRBIT
ADDM C,ARRLIN
TLNE T,WINBIT
ADDM C,WINLIN
JUMPGE T,CPOPJ
ADDI A,LLDESC+LPMTXT
MOVE T,1(A)
TRNN T,-1
HRRI T,XPLSTE
PUSHJ P,LSTSH1
SUBI A,LLDESC+LPMTXT
POPJ P,
;FNDLIN, FNDPAG, FNDLN1, FNDLN2, FNDLN3
FNDPAG: CAMN A,CURPAG
JRST FNDPA2 ;Not changing pages
MOVE T,ARRL
HRL T,CURPAG
MOVEM T,LSTPLC# ;Remember page and line we came from.
MOVE T,TOPWIN
MOVEM T,LSTWIN# ;Remember window setting too
FNDPA2: SKIPA T,[DPTRTB,,DPTRT2]
FNDLIN: MOVE T,[LPTRTB,,LPTRT2]
HLRM T,FNDPT1
HRRM T,FNDPT2
MOVE T,-1(T)
HRLOI TT,377777
MOVEM TT,FNDTM1#
FNDLN1: MOVEI TT,(A)
SUB TT,@FNDPT1
MOVM TT,TT
CAMGE TT,FNDTM1
SKIPN @FNDPT2 ;IGNORE IF PNTR NOT SET
AOBJN T,FNDLN1
JUMPGE T,FNDLN2
MOVEM TT,FNDTM1
MOVEM T,FNDTM2#
AOBJN T,FNDLN1
FNDLN2: MOVE T,FNDTM2
MOVEI TT,(A)
SUB TT,@FNDPT1
ADD T,FNDPT2
XCT (T)
JUMPE TT,CPOPJ
SETZM FNDPAD# ;Fndpag direction for TELLME
JUMPL TT,FNDLN3
SETOM FNDPAD ;Ditto
HRRZ T,(T)
SOJG TT,.-1
POPJ P,
FNDLN3: HLRZ T,(T)
AOJL TT,.-1
POPJ P,
;REMPTR FIXPTR FNDPT1 FNDPT2 LPTRTB DPTRTB ARRL TOPWIN LINES FIRPAG CURPAG PAGES
;This AND's the complement of ARRBIT into the left half of (location in ARRLIN)+1
; if ARRLIN is non-zero and sets ARRLIN to zero
;Also AND's the complement of WIMBIT into the left half of (location in WINLIN)+1
; if WINLIN is non-zero and sets WINLIN to zero.
REMPTR: FOR @! X IN(ARR,WIN)
{ MOVSI TT,X!BIT
SKIPE T,X!LIN
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
SETZM X!LIN
} POPJ P,
;This fixes the pointers in the data for the line in question
; The location in ARRL is used by FINLIN to update ARRLIN and to compute the
; value which is ORed into the location 1 beyond that in ARRLIN.
; The location in WINL is similarly used to update WINLIN and to compute the
; value which is ORed into the location 1 beyond that in WINLIN.
FIXPTR: FOR @! X IN(ARR,WIN)
{ MOVE A,X!L
PUSHJ P,FNDLIN
MOVEM T,X!LIN
MOVSI TT,X!BIT
IORM TT,TXTFLG(T) ;Was IORM TT,1(T)
} POPJ P,
IMPURE
FNDPT1: (T)
FNDPT2: @(T)
LPTRTB←←.
ARRL: 0
TOPWIN: 0
1
LINES: 0
LPTRTB-.,,
LPTRT2: HRRZ T,ARRLIN
HRRZ T,WINLIN
HRRZ T,PAGE
HLRZ T,BOTSTR
WINL←←TOPWIN ;FOR FIXPTR
DPTRTB←←.
CURPAG: 0 ;Number of last in-core page (usually same as FIRPAG)
FIRPAG: 0 ;Number of first in-core page
1
PAGES: 0 ;Number of last page in the file
DPTRTB-.,,
DPTRT2: HRRZ T,DIRPT
HRRZ T,DIRP1
HRRZ T,DIR
HLRZ T,DIREND
PURE
;DIRGET, DIRGL, DGEND, DRGSET
DIRGET: HRRZ T,DIR
MOVEM T,DIRGPT# ;BETTER THE HELL NOT CAUSE SHUFFLAGE
SETZM DIRGPG#
MOVE C,[170700,,DIRHED+3]
MOVEM C,INPNT
MOVE C,PAGES
PUSHJ P,NUM5
MOVE C,[440700,,DIRHED]
JSP Q,RLDX
SKIPE VBUF
SKIPA C,[440700,,VBUF]
MOVE C,[440700,,[BYTE (7)15,12,177]]
JSP Q,RLDX
MOVE C,[440700,,DIRHD2]
DIRGL: JSP Q,RLDX
MOVE C,[350700,,DIRTXT]
MOVEM C,INPNT
MOVE C,DIRGPT
HRRZ C,1(C)
PUSHJ P,NUM5
IBP INPNT
AOS C,DIRGPG
CAMLE C,PAGES
JRST DGEND
PUSHJ P,NUM5
MOVE C,[440700,,DIRTXT]
JSP Q,RLDX
HRRZ C,DIRGPT
HRRZ Q,(C)
MOVEM Q,DIRGPT
ADD C,[440700,,LPDESC]
JRST DIRGL
DGEND: MOVEI C,177
IDPB C,INPNT
TRNN F,DIROK
SKIPA C,[440700,,DIRUNK]
MOVE C,[440700,,DIRTXT]
JSP Q,RLDX
MOVE C,[440700,,DIREMK]
JSP Q,RLDX
SUB P,[1,,1]
XCT -1(DSP)
DRGSET: MOVEI Q,DIRGET
TRO F,EDDIR
MOVEI DSP,DGDSP
PUSHJ P,SETRLD
MOVEI A,1
JRST RDPAG2
;NUM5, NUM5A, DIRHED, DIRTXT, DIREMK, DGDSP
NUM5: HRLI C,12*12*12*12*12/2
NUM5A: PUSH P,D
IDIVI C,12
TLNE C,-1
PUSHJ P,NUM5A
ADDI D,"0"
IDPB D,INPNT
POP P,D
POPJ P,
IMPURE
DIRHED: ASCII /COMMENT ⊗ VALID XXXXX PAGES/
BYTE (7)177
DIRHD2: ASCII /C REC PAGE DESCRIPTION
/
BYTE (7)177
DIRTXT: ASCII /Cxxxxx xxxxx/
BYTE (7)177
DIREMK: ASCII /ENDMK
C⊗;
/
BYTE (7)177
XDIRCH←←=77 ;# CHARS IN FIRST 2 & LAST LINES
VBUF: BLOCK 10
PURE
DIRUNK: ASCII /
AND WHO KNOWS HOW MANY MORE . . .
/
BYTE (7)177
JRST RDLDON
DGDSP: JSP C,[JRST -3(C)]
PUSHJ P,(Q)
JRST RDLCR
JRST RDLLF
JRST RDLTAB
PUSHJ P,TELL5
PUSHJ P,TELL6
;OUTDIR, OUTDOK, OUTDLP, ODDSP, ODDON, ODEXP
OUTDIR: TRNN F,REDNLY
SKIPN DIRPAG
POPJ P,
MOVE A,DIRSIZ
ADDI A,200*5-1+200*5 ;+1 TO GET REC #
IDIVI A,200*5
MOVEM A,NEWSIZ
HRRZ B,@DIR
HRRZ B,1(B) ;START OF PG 2
CAILE A,(B)
JRST ODEXP
OUTDOK: MOVEI E,EDFIL
PUSHJ P,OPENW
MOVEI A,1
PUSHJ P,SETO
MOVEI DSP,ODDSP
MOVEI Q,DIRGET
PUSHJ P,SETRLD
ODOLP: MOVE G,OPNT
MOVE E,OCNT
OUTDLP: GETCHR
IDPB C,G
SOJG E,OUTDLP
PUSHJ P,WRBUF
JRST ODOLP
JRST ODDON
ODDSP: JSP C,[JRST -3(C)]
PUSHJ P,(Q)
ODDON: MOVNI T,1
PUSHJ P,WRCHK
CAME T,DIRSIZ
FATAL DIRECTORY WRITER LOST
MOVEM T,ODSIZ
MOVEM G,OPNT
PUSHJ P,CLOSO
HRRZ T,@DIR
HRRZ T,1(T)
SUB T,NEWSIZ
JUMPLE T,CPOPJ
MOVE A,[OBUF-1,,OBUF]
BLT A,OBUF+177
PUSHJ P,WRBUF
SOJG T,.-1
POPJ P,
ODEXP: TRNE F,WRITE
PUSHJ P,TELLZ
MOVEI A,
JRST WRPX0
;INSDIR, DCLP1, DCLP2, DCNG, INSDL
;This calculates the new directory line for a page whose first line has changed.
INSDIR: TRNE F,EDDIR ;If the current page is the directory, then
POPJ P, ; there is nothing to worry about.
HRRZ D,PAGE ;Pointer to first line of current page.
MOVE A,DIRP1 ;Pointer to directory line for current page.
SKIPE XPAGES ;Skip if no extra pages in core.
JRST INSD3
INSD1: PUSH P,A
ADD D,[440700,,LLDESC]
MOVE T,TXTCNT-LLDESC(D) ;Was MOVE T,1-LLDESC(D)
TLNN T,777777
JRST IDNUL
TRNN T,777777
HRLI D,350700
MOVEI DSP,IDDSP
MOVE A,[440700,,T] ;Registers T and TT are used to save cap. version
SETZB T,TT
MOVNI B,8
PUSH P,D
DCLP1: ILDB C,D
CAIL C,140
SUBI C,40
IDPB C,A
CAILE C,40
AOJL B,DCLP1
JUMPGE B,DCNG
MOVEI G,8+1(B)
MOVE H,CTAB(C)
TLNE H,LSPC
XCT IDDSP0-2(H)
DCLP1A: MOVSI B,-NSCOMS
DPB B,A
DCLP2: CAMN T,SCOMS(B)
CAME TT,SCOMS2(B)
AOBJN B,DCLP2
DCNG: POP P,T
JUMPL B,.+2
TDZA B,B
SKIPA B,G
MOVE D,T
MOVSI E,DSPC+LSPC+NSPEC
MOVE A,[700,,BUF-1]
MOVEI C,11
IDPB C,A
INSDL: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,A
AOJA B,INSDL
;IDDSP0, IDDSP, IDTAB, INSD3, INSD4, SCOMS, SCOMS2
IDDSP0: ADD D,[70000,,]
PUSHJ P,TELLZ
JRST IDTAB0
PUSHJ P,TELLZ
IDDSP: PUSHJ P,TELL0
PUSHJ P,TELL1
JRST IDDON
PUSHJ P,TELL3
JRST IDTAB
PUSHJ P,TELL5
PUSHJ P,TELL6
PUSHJ P,TELL7
AOJA B,INSDL
IDTAB0: SUBI G,8+1+1
IBP D
AOJL G,.-1
JRST DCLP1A
IDTAB: IDPB C,A
HRLS B
TLO B,-10
IBP D
AOBJN B,.-1
IBP D
JRST INSDL
INSD3: PUSHJ P,INSD1
TLO F,NOSHUF
HRRZ A,@DIRP1
HRRZ D,XPLST
INSD4: PUSH P,A
PUSH P,D
HRRZ D,-LLDESC-LPMTXT(D)
PUSHJ P,INSD1
POP P,D
POP P,A
HRRZ A,(A)
HRRZ D,(D)
JUMPN D,INSD4
TLZ F,NOSHUF
POPJ P,
SCOMS: ASCII/COMME/
ASCII/SUBTT/
NSCOMS←←.-SCOMS
SCOMS2: ASCII/NT/
ASCII/L/
;IDNUL, IDDON, IDDONS
IDNUL: MOVE A,[700,,BUF-1]
MOVEI C,15
IDDON: IDPB C,A
MOVEI B,1
FOR X IN(12,177){MOVEI C,X↔IDPB C,A↔}
TLNE A,760000
AOJA B,.-2
MOVEI E,-BUF+1(A)
MOVEI C,LPDESC(E)
IMULI E,5
SUB E,B
POP P,A
HRRZ T,2(A)
SUBM E,T
ADDM T,DIRSIZ
HLL E,2(A)
HRRZ B,-1(A)
CAIN C,-2(B)
JRST IDDONS
CAIL C,-2(B)
TLO F,NOCHK
MOVE B,C
PUSH P,1(A)
MOVE T,(A)
PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
PUSHJ P,FSGIVE
TLZ F,NOCHK
PUSHJ P,FSGET
MOVSI T,DIRCOD
HLLM T,-1(A)
POP P,T
MOVEM T,(A)
HRLM A,(T)
MOVS T,T
HRRM A,(T)
POP P,1(A)
JUMPGE E,.+2
MOVEM A,DIRPT
TLNE E,D1BIT
MOVEM A,DIRP1
IDDONS: MOVEM E,2(A)
MOVSI T,BUF
HRRI T,LPDESC(A)
ADDI C,(A)
BLT T,-1(C)
POPJ P,
;DIRSET, DIRST1, DIRUP, DIRUP1, DIRUP2, DIRUP3
DIRSET: HRRZ A,DIRP1
HRRZ T,1(A)
DIRST1: HLLZ TT,1(B)
ROT TT,8
TLNE TT,-1
ADDI TT,1
ADDI T,(TT)
HRRZ A,(A)
CAME T,1(A)
TRO F,UPDIR
MOVEM T,1(A)
HRRZ B,(B)
JUMPN B,DIRST1
POPJ P,
DIRUP: SKIPN B,DPLST#
JRST DIRUP2
DIRUP1: MOVEI A,(B)
HRRZ B,(A)
PUSHJ P,FSGIVE
CAIE B,DPLST
JRST DIRUP1
SETZM DPLST
DIRUP2: HRRZ A,DIRP1
MOVEI B,1
DIRUP3: DPB B,[RPBYTE+2(A)]
SKIPGE 2(A)
POPJ P,
HRRZ A,(A)
AOJA B,DIRUP3
;DIRFIX, DIRFX1, DIRFX2, DIRFX3, DIRFX4, DIRFXN
DIRFIX: HRRZ A,DIRP1
TLO F,NOSHUF
SKIPN B,DPLST
JRST DIRFX4
DIRFX1: HLLZ T,2(A)
TLNN T,RPMASK
PUSHJ P,DIRFXN
TLZ T,¬RPMASK
CAML T,2(B)
JRST DIRFX3
SKIPGE 2(A)
JRST DIRFX2
HRRZ A,(A)
JRST DIRFX1
DIRFX2: MOVSI T,DPBIT
ANDCAM T,2(A)
IORM T,2(B)
HRRZM B,DIRPT
HRRZ A,(A)
DIRFX3: HLL A,(A)
HRRZ T,(B)
MOVEM A,(B)
HRLM B,(A)
MOVS A,A
HRRM B,(A)
HRRZ A,2(B)
ADDI A,=12
ADDM A,DIRSIZ
AOS CURPAG
AOS PAGES
MOVEI A,(B)
MOVEI B,(T)
CAIE B,DPLST
JRST DIRFX1
SETZM DPLST
DIRFX4: HLLZ T,2(A)
TLNN T,RPMASK
PUSHJ P,DIRFXN
HRRZ A,(A)
JUMPGE T,DIRFX4
TLZ F,NOSHUF
POPJ P,
DIRFXN: PUSHJ P,DELPG1
HLRZ C,(A)
PUSHJ P,FSGIVE
MOVEI A,(C)
HLLZ T,2(A)
POPJ P,
;DISPLAY DATA STORAGE
IMPURE
;DPY is E's opinion of what type of display the user is on.
DPY: 0 ;0 for TTY or Imlac, 1 for DD, 2 for III
IMLDPY: 0 ;non-zero if Imlac or display
IMLACL: 0 ;non-zero if on Imlac
NLINES: =40
=42
SCRTOP: 2
PPSIZ: 3
LINMAX: =21+2+LLDESC
ARRPOS: 0 ;TTY
CW 1,46,3,1,3,1 ;DD
BYTE(11)<-24>,0(3)0,0(2)0,2(4)6 ;III
AR2POS: 0 ;TTY
CW 1,66,3,1,3,1 ;DD
BYTE (11)<-24>,0(3)0,0(2)0,2(4)6 ;III
ARPOS2: 0 ;TTY
CW 1,46,3,1,3,1 ;DD
BYTE (11)<-14>,0(3)0,0(2)0,2(4)6 ;III
ARRBUF: BLOCK 5
;This is the one of FW's winning tables which is accessed with DPY-1
FIRWRD: CW 1,46,2,0,3,2
0
LEDTST: 0
CAILE TT,IMCHRL ;TTY (really Imlacs)
CAIL T,EDWRDL ;DD
CAIL T,EDWRDL ;III
DISPI: 0
JRST TDISP ;TTY
PPINFO RBUF ;DD
PPINFO RBUF ;III
WIPI: POPJ P, ;In case WIPE called before DPYINI
POPJ P, ;TTY
PUSH P,A ;DD
JRST IWIPE ;III
DBLTI: 0
LDB T,[300700,,DPYTAB(G)]
JRST DBLT2
PCOMP: POPJ P, ;TTY - MUST BE REASONABLE INSTR
JRST PCOMPD ;DD
JRST PCOMPI ;III
P2COMP: POPJ P, ;TTY - MUST BE REASONABLE INSTR
JRST P2CMPD ;DD
JRST P2CMPI ;III
;MORE DISPLAY STORAGE
DISPXA: 0 ;TTY
DDISPX ;DD
IDISPX ;III
DISP1A: 0 ;TTY
DDISP ;DD
IDISP ;III
DISP2I: 0
TRNE F,EDITM
JRST DISP3
LEPREP: 0
JFCL ;TTY
PUSHJ P,LEADJ ;DD
JFCL ;III
LETST: 0
JFCL ;TTY
CAIG T,=84 ;DD
JFCL ;III
SPCOUT: 0
PUSH H,[CW 1,46,1,46,1,46]
JFCL
DPYHED: SETZ DPYBUF
0
DDACT: 0
DPYBUF: BLOCK DPYBSZ
100,,
DPYTAB: BLOCK MAXLIN
DPYLOC: BLOCK MAXLIN
MASK: 0
CW(0,377,7,0,0,377)+3
BYTE(11)3777,0(3)7,0(2)3,0(4)17
BRKTAB: BLOCK 4 ;For reading activation table
;HEADERS & TRAILERS -- TOPSTR HEDPAG HEDNAM ROFLG WFLAG TOPDSH HEDLIN BOTSTR DOTS
LTPSTR+2
TOPSTR: BLOCK LLDESC
ASCID/************ PAGE/
HED3PG: ASCID/ / ;HOLDS " " OR "S "
HEDPAG: BLOCK 1 ;FIRPAG goes here
HED5PG: 1 ;In multipage mode, ":" stored here
1 ;In multipage mode, CURPAG goes here
HEDNAM: BLOCK 7
ROFLG: BLOCK 1
ASCID/ ************ /
WFLAG: BLOCK 1
UFLAG: BLOCK 1 ;For holding " U" meaning dir needs updating
ASCID/
/
LTPSTR←←.-TOPSTR
LTPDSH+2
TOPDSH: BLOCK LLDESC
ASCID/.....Line /
HEDLIN: BLOCK 1
ASCID/.....PAGE/
HED4PG: ASCID/ / ;HOLDS " " OR "S "
HED2PG: BLOCK 1
HED6PG: 1
1
HED2NM: BLOCK 7
ROFLG2: BLOCK 1
ASCID/...../
WFLAG2: BLOCK 1
UFLAG2: BLOCK 1
ASCID/
/
LTPDSH←←.-TOPDSH
LBTSTR+2
BOTSTR: .
BLOCK LLDESC-1
ASCID/***** Arrow at Line /
BOTARR: BLOCK 1
ASCID/ of /
BOTLN5: BLOCK 1
ASCID/ ***** Page /
BOTPG2: BLOCK 1
ASCID/ of /
BOTPG3: BLOCK 1
ASCID/ ***** /
RFLAG3: 1 ;To contain Record values
WFLAG3: 1 ;To contain B and X values
ASCID/ *****
/
LBTSTR←←.-BOTSTR
LBTDSH+2
BOTDSH: BLOCK LLDESC
ASCID/.....Arrow at Line /
BOTAR2: BLOCK 1
ASCID/ of /
BOTLN4: BLOCK 1
ASCID/.....Page /
BOTPG4: BLOCK 1
ASCID/ of /
BOTPG5: BLOCK 1
ASCID/...../
RFLAG4: 1 ;To contain Record values
WFLAG4: 1 ;To contain B and X values
ASCID/.....
/
LBTDSH←←.-BOTDSH
PURE
LDOTS+2
DOTS: 0
0
0,,-5 ;Phony serial number and flags
ASCID / . . .
/
LDOTS←←.-DOTS
;DPYINI DPYCHK TTYTST MTLINE LOADMT
MTLINE: 0 ;Do a PTLOAD MTLINE to avoid ALLACT activations.
[ASCIZ/
/]
LOADMT: SKIPE MACPNT
JRST POPJ1 ;Expanding macro, take skip return.
SKIPG DPY
POPJ P, ;Don't do PTLOAD if not a display.
PTJOBX [0↔3] ;Don't echo type-ahead again.
PTLOAD MTLINE ;Load null line to give us our 400s and disable ALLACT.
PTJOBX [0↔4] ;Give us back our echoing.
POPJ P,
DPYINI: SETOM TTYNUM
SETOM DPY
MOVEI T,"→"*2+1
MOVEM T,ARRON#
DPYCHK: PUSH P,A
MOVNI A,1
GETLIN A
TLNE A,PTY
HRRZ A,A ;If running on a PTY, he's not on a display!
MOVEI DSP, ;0 means TTY (or Imlac)
TLNE A,DD
MOVEI DSP,1 ;1 means Data Disc
TLNE A,III
MOVEI DSP,2 ;2 means III
SETZM IMLACL ;Assume not on imlac
TLNE A,IMLIN
SETOM IMLACL ;Running on Imlac
HRRZ A,A
CAMN A,TTYNUM
JRST POPAJ
MOVEM A,TTYNUM#
TRO F,DSPALL
CAMN DSP,DPY
JRST POPAJ
PUSH P,B
PUSH P,T
PUSH P,TT
MOVEM DSP,DPY
MOVEM DSP,IMLDPY ;Set non-zero here for display, below for imlac
SKIPE IMLACL
SETOM IMLDPY ;Running on Imlac (DPY=0)
MOVE T,LEDTST+1(DSP) ;Instruction to test line length against line editor
MOVEM T,LEDTST
MOVE T,PPSET+1(DSP) ;Routine to position PP and set up CRLF routines.
MOVEM T,PPSET
MOVE T,BEEPUU+1(DSP) ;UUO used to "beep" user.
MOVEM T,BEEPUU
MOVE T,WIPI+1(DSP)
MOVEM T,WIPI
MOVE T,DISPI+1(DSP)
MOVEM T,DISPI
MOVE T,SRCDPY+1(DSP)
MOVEM T,SRCDPY ;For displaying search page number
MOVE T,SRCDP3+1(DSP)
MOVEM T,SRCDP3 ;For erasing search page number
MOVE T,LETST+1(DSP)
MOVEM T,LETST ;For moving page down when editing long line on DD.
MOVE T,LEPREP+1(DSP)
MOVEM T,LEPREP ;For moving page down when editing long line on DD.
SETZM LSTARR#
SETZM LSTPAG#
SOJL DSP,NODPY ;Decrement display type and jump if TTY
SETACT [BRKTAB,,[-1↔-1↔-1↔-1,,600000!SUPCCR!EMODE!ALLACT]]
;Suppress ctrl cr and turn on EMODE for 400s
MOVE T,BRKTAB+3
TRNN T,EMODE ;Was EMODE already on?
PUSHJ P,LOADMT ;Load null line to give us our 400s!
JFCL ;LOADMT skips if expanding a macro
;At this point, DSP contains one less than display type
MOVE T,FIRWRD(DSP)
MOVEM T,DPYBUF
MOVEM T,SRCDD ;For displaying search page number
MOVE T,SRCDP2(DSP)
MOVEM T,SRCDD+1
FOR X IN(ARRPOS,AR2POS,PCOMP,P2COMP,DISPXA,DBLTI,DISP1A,<DISP2I>
,SPCOUT,ARPOS2,MASK)
{ MOVE T,X+1(DSP)
MOVEM T,X
}
;DPYI2, NODPY, WIPE, IWIPE
DPYI2: MOVE G,NLINES(DSP) ;Note that TTYs and DDs get here w/DSP=0
SUB G,PPSIZ
MOVEM G,PPPOS#
PUSHJ P,P2COMP
HRRZM T,DPPPOS#
MOVE T,PPSIZ
LSH T,9
TRO T,1
MOVEM T,DPPSIZ#
PUSHJ P,@PPSET
MOVE B,PPPOS
MOVE A,SCRTOP
SUB B,A
PUSHJ P,SETSCR
MOVE T,[DPYTAB-1,,DPYTAB]
BLT T,DPYTAB+MAXLIN-1
TRO F,DSPALL
PUSHJ P,WIPE
POP P,TT
POP P,T
IFN PURESW,{
SKIPL JOBHRL↑
OUTSTR [ASCIZ/Upper segment not write protected.
/]
};PURESW
JRST POPBAJ
NODPY:
; OUTSTR[ASCIZ /UGH, NO DISPLAY. GOOD LUCK!
;/]
AOJA DSP,DPYI2
;here to erase screen
WIPE: XCT WIPI ;PUSH P,A for DD; JRST IWIPE for III
PUSH P,B
MOVE H,[-DPYBSZ+1,,DPYBUF]
PUSH H,POSWRD
SETZM BLNKL
SKIPE DDACT
DPYOUT [0↔0]
MOVE G,SCRTOP
PUSHJ P,WIPIT ;Put in enough blank lines to erase screen.
PUSHJ P,DDCOP ;CAN'T POSSIBLY SKIP ;Double buffer for second field.
MOVEI G,10000
IORM G,DPYBUF+1(TT) ;Turn on second field bit in DD command word
MOVE B,TT
MOVEI H,DPYBUF-1-1(T) ;Now point to last word in doubled buffer
PUSHJ P,DDCOP ; and double it again
MOVEI G,20000 ; this time moving down 2 raster lines
ADDM G,DPYBUF+1(TT) ; to erase the lines between the lines
ADD TT,B
ADDM G,DPYBUF+1(TT) ;Down 2 raster lines with second field.
SETOM OLDARR
JRST DISPX ;Now put out dislay and POP A and B.
IWIPE: PGCLR
POPJ P,
;SETSCR NMVAR1 NMVARR MOVARR SETARR DSTRL TRLARR GOLINE TRAILS TRAIL0
SETSCR: MOVEM A,SCRTOP
MOVEM B,SCRSIZ#
LSH B,-1
SOJ B,
MOVEM B,GTDEL#
SETZM BLNKL
MOVE G,A
PUSHJ P,PCOMP
MOVEM T,POSWRD#
SKIPN PAGE
POPJ P,
PUSHJ P,LINSET
MOVEI A,1
JRST SETWIN
;Go to specific line whose number is argument.
GOLINE: CAIE B,3 ;αβL means absolute line number of incore pages
SKIPN XPLST
JRST GOLIN2
;Anything else means relative to "arrow page"
PUSHJ P,GPAGL ;Get <line>,,<page> for arrow line
HLRZ B,T ;Save line number
ANDI T,-1 ;Just page number for now
CAME T,FIRPAG ;Pointing to first incore page?
JRST GOLIN3
HLRZ T,2(TT) ;Line number of first pagemark (below arrow)
JRST GOLIN4 ;T now holds max line number allowed to move to
GOLIN3: HLRZ T,2(TT) ;Line number of pagemark beginning arrow page
HRRZ TT,(TT) ;Next pagemark
JUMPN TT,GOLIN5
MOVEI T,-1 ;Arrow page is last one in core--no limit to line number
JRST GOLIN4
GOLIN5: HLRZ TT,2(TT) ;Line number of pagemark ending arrow page
SUB TT,T ;Max line number accepted for arrow page
MOVE T,TT
GOLIN4: TRNE F,REL
ADDI A,(B) ;Relative to current line
JUMPG A,.+2
MOVEI A,1 ;Can't go back beyond line 1 of arrow page
CAMLE A,T
MOVE A,T ;Can't go beyond last line +1 of arrow page
SUBI A,(B) ;Amount to move
JRST MOVARR
GOLIN2: TRNN F,REL
JRST SETARR
JRST MOVARR
TRC T,SBKWDS ;This instruction XCTed if Find string ended with ⊗BS or ⊗U
NMVAR1: AOS (P)
NMVARR: MOVNS A
MOVARR: ADD A,ARRL
SETARR: MOVE T,LINES
CAIGE A,1
MOVEI A,1
CAILE A,1(T)
MOVEI A,1(T)
CAILE A,(T)
TLOA F,OFFEND
TLZ F,OFFEND
PUSHJ P,FNDLIN ;Gets new line pointer-location into T
MOVEM A,ARRL
CAME A,SRCL
SETOM SRCOFF ;No search string found on this line
MOVSI TT,ARRBIT
EXCH T,ARRLIN# ;Replaces ARRLIN value and gets old location into T
JUMPE T,.+2
ANDCAM TT,TXTFLG(T) ;Turns old ARRBIT OFF Was ANDCAM TT,1(T)
MOVE T,ARRLIN ;Now go to new line
IORB TT,TXTFLG(T) ;and set its ARRBIT Was IORB TT,1(T)
TLNE TT,PMARK ;Is it a page mark?
TLOA F,PMLIN ;Yes (this makes the sign negative)
TLZ F,PMLIN ;No
HRRZ TT,TXTCNT(T) ;Is it a null line? (New to permit TXTCNT≠TXTFLG)
SKIPE TT
TLZA F,NULLIN ;No
TLO F,NULLIN ;Yes
TLO F,DSPTRL ;Force recalculation of trailer values
POPJ P,
;To put corrected value of ARRL in the trailer text
REPEAT 0,<
TRLARR: PUSH P,A
PUSH P,C
PUSH P,T
PUSH P,TT
MOVE T,ARRL
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,BOTARR
MOVEM C,BOTAR2
PUSHJ P,DSTRL ;This forces a redisplay of the TRLBLK
POP P,TT
POP P,T
POP P,C
POP P,A
POPJ P,
>;REPEAT 0
TRAIL0: PUSHJ P,WINCHK ;Set up window if necessary--clobbers A and B
TLZ F,DSPTRL ;TRAILS expects this flag to be off
TRAILS: PUSH P,C
PUSHJ P,GPAGL
PUSH P,T ;Save <line>,,<page>
SKIPN XPLST
JRST TRAIL2 ;Only one page in core
MOVEI T,(T)
CAME T,FIRPAG
JRST TRAIL3
HLRZ T,2(TT) ;Line number of first pagemark
SOJA T,TRAIL4
TRAIL3: HLRZ T,2(TT) ;Line number of pagemark beginning pointed-to page
MOVN T,T
HRRZ TT,(TT) ;Next pagemark
JUMPN TT,TRAIL5
ADD T,LINES ;Final page in core is pointed to
JRST TRAIL4
TRAIL5: HLRZ TT,2(TT) ;Line number of next pagemark
ADDI T,-1(TT) ;Don't count pagemark line itself in line count
JRST TRAIL4
TRAIL2: MOVE T,LINES
TRAIL4: CAMN T,DLINES#
JRST TRAIL6 ;Number of lines hasn't changed
TLO F,DSPTRL
MOVEM T,DLINES
PUSHJ P,NUMSTD
MOVEM C,BOTLN4
MOVEM C,BOTLN5
TRAIL6: HLRZ T,(P) ;Get current line
CAMN T,DARRL#
JRST TRAIL7
TLO F,DSPTRL
MOVEM T,DARRL
PUSHJ P,NUMSTD
MOVEM C,BOTARR
MOVEM C,BOTAR2
TRAIL7: POP P,T
MOVEI T,(T) ;Current page
CAMN T,DCURPG#
JRST TRAIL8
TLO F,DSPTRL
MOVEM T,DCURPG
PUSHJ P,NUMSTD
MOVEM C,BOTPG2
MOVEM C,BOTPG4
TRAIL8: MOVE T,PAGES ;Now get the total number of pages
CAMN T,DPAGES#
JRST TRAIL9
TLO F,DSPTRL
MOVEM T,DPAGES
PUSHJ P,NUMSTD ;Get ASCID equivalent
TRNN F,DIROK ;Is the directory OK?
MOVE C,[ASCID /? /] ;No, so say "? "
MOVEM C,BOTPG3 ;Deposit the total page count
MOVEM C,BOTPG5 ;on both types of bottom line
TRAIL9: MOVE T,ROOM ;Code to put C, B, and X values on trailer.
SUB T,CHARS
CAMN T,DBLOAT#
JRST SETWR7
MOVEM T,DBLOAT
TRNE F,FILLUZ
JRST TRAI11 ;Record and bloat numbers are meaningless
SETZM WFLAG5#
JUMPGE T,SETWR4
SETOM WFLAG5 ;Flag is - if not enough room
MOVMS T
SETWR4: CAIG T,200*5
JRST SETWR5 ;Report difference as a + or - number
IDIVI T,200*5 ;But in this case as number of records
SKIPE WFLAG5
ADDI T,1 ;Minimum X value is 2
PUSHJ P,NUMSTD ;Convert to ASCID
SKIPE WFLAG5
TRO C,"X"⊗1
SKIPN WFLAG5
TRO C,"B"⊗1
JRST SETWR6
SETWR5: PUSHJ P,NUMSTD ;Convert to ASCID
LSH C,-7 ;Make room for sign
SKIPE WFLAG5
TLO C,"+"⊗13 ;Report needed space as +
SKIPN WFLAG5
TLO C,"-"⊗13 ;Report available space as -
TROA C,"C"⊗1!1 ;Add the letter C and make it ASCID
TRAI11: MOVEI C,1 ;No B/X/C field if file not formatted
SETWR6: CAMN C,WFLAG3
JRST SETWR7
TLO F,DSPTRL
MOVEM C,WFLAG3
MOVEM C,WFLAG4
SETWR7: MOVE T,ROOM ;Now figure out number of records available
CAMN T,DROOM#
JRST TRAI10
TLO F,DSPTRL
MOVEM T,DROOM
IDIVI T,200*5
PUSHJ P,NUMSTD
TRNE F,FILLUZ
MOVSI C,(<ASCII/ ?/>) ;File not formatted, say ?R
TRO C,"R "⊗1!1
MOVEM C,RFLAG3
MOVEM C,RFLAG4
TRAI10: TLZE F,DSPTRL ;Did we find anything had changed?
PUSHJ P,DSTRL ;Yes, force redisplay of bottom line
POP P,C
POPJ P,
;This is now only called from TRAILS above, which is only called from DISP,
;which has just called WINCHK, so TOPWIN and BOTWIN should always be valid here.
DSTRL:
; SKIPG BOTWIN ;Can't do anything if don't know where bottom is.
; POPJ P,
MOVE T,ATTNUM ;To set indicator to display trailer line
CAILE T,ATTMAX
MOVEI T,ATTMAX
ADD T,BOTWIN
SUB T,TOPWIN
; SKIPL T ;Make sure in range
; CAIL T,MAXLIN-4
; POPJ P, ;Don't try to clear RH of cell if error in value
HLLZS DPYTAB+3(T) ;Force redisplay of trailer line
TRO F,DSPSCR
POPJ P,
;SETWIN WINCHK WINCH2 GLDOWN GLUP POPWIN DWNWIN REWIN CENWIN SETWN2
;Glitch commands
GLUP: MOVN A,A ;Move text up
GLDOWN: MOVE B,A ;Numeric arg into B
ASH B,2 ;Four lines per somethingorother
TRNE F,EDITM ;If glitching while in line editor, don't want
JUMPN A,JMPGL ; to move arrow line, so use JMP routine
MOVE A,TOPWIN
SUB A,B
CAMLE A,WINMAX
MOVE A,WINMAX
JUMPG A,.+2
MOVEI A,1
CAMLE A,ARRL
PUSHJ P,SETARR ;Move arrow down to keep it on new window
PUSH P,A
ADD A,SCRSIZ ;Find number of new BOTWIN line
SUBI A,3
MOVE B,ATTNUM ;Number of attach lines displayed decreases the
CAILE B,ATTMAX ; size of the window
MOVEI B,ATTMAX
SUB A,B
CAML A,LINES
JRST POPWIN
CAMGE A,ARRL
PUSHJ P,SETARR ;Move arrow up to keep it on new window
POPWIN: POP P,A
SETWIN: CAMLE A,WINMAX
MOVE A,WINMAX
CAIG A,1
SKIPA A,[1]
SKIPA B,[TOPDSH]
MOVEI B,TOPSTR
MOVEM B,HEDBLK#
CAME A,WINMAX
SKIPA B,[BOTDSH]
MOVEI B,BOTSTR
MOVEM B,TRLBLK#
CAME A,TOPWIN
TRO F,DSPSCR ;If this is used we only redisplay text as required
PUSH P,A
ADD A,SCRSIZ
SUB A,EXTRA
SUBI A,3
CAMLE A,LINES
MOVE A,LINES
AOJ A,
MOVEM A,BOTWIN#
POP P,A
MOVEI T,-1(A)
SUB T,SCRTOP
MOVNM T,OFFSET#
PUSHJ P,FNDLIN
MOVEM A,TOPWIN
MOVSI TT,WINBIT
SKIPE B,WINLIN
ANDCAM,TT,TXTFLG(B) ;Was ANDCAM TT,1(B)
MOVEM T,WINLIN#
IORM TT,TXTFLG(T) ;Was IORM TT,1(T)
;Now put line numbers at top and bottom
PUSH P,C
MOVE T,TOPWIN ;Line number of line at the top
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,HEDLIN
PUSHJ P,DSHED ;Force header to be redisplayed
REPEAT 0,<
MOVE T,ARRL ;Now report Arrow line
PUSHJ P,NUMSTD
MOVEM C,BOTARR
MOVEM C,BOTAR2
POP P,C
SETWN2: PUSH P,C
MOVE T,LINES
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,BOTLN4 ;Both numbers needed for dash bottom line
MOVEM C,BOTLN5 ;Also on asterisk line as of 6feb76
PUSHJ P,DSTRL ;Force trailer to be redisplayed
>;REPEAT 0
POP P,C
POPJ P,
WINCHK: MOVE A,ARRL
CAMGE A,TOPWIN
JRST CENWIN ;Arrow is above screen, center screen around window
WINCH2: CAML A,BOTWIN
JRST DWNWIN ;Arrow apparently below screen
POPJ P,
DWNWIN: CAMLE A,LINES
SOJA A,WINCH2 ;Arrow on extra line of stars, check again
SKIPGE BOTWIN ;Arrow is below screen
JRST REWIN ;Screen isn't really set up
CENWIN: MOVE B,SCRSIZ
ASH B,-1 ;Half of screen size
SUBI A,(B)
AOJA A,SETWIN ;Center screen around arrow
REWIN: MOVE A,TOPWIN
PUSHJ P,SETWIN
MOVE A,ARRL
JRST WINCH2
;DISP DISP0 DISP1 DISP2 DISP6
DISP6: PUSH P,A
PUSH P,B
PUSHJ P,WINCHK ;Make sure window limits are set up correctly
JRST PPBAJ1
DISP: SKIPE MACPNT ;Don't do anything if expanding macro now,
JRST DISP6 ; except set up window.
DISP0: PUSH P,A ;DRAW enters here if coming from macro expansion.
PUSH P,B
TRNN F,EDITM
PUSHJ P,LECLR
PUSHJ P,WINCHK
XCT @-2(P)
AOSA -2(P)
JRST PPBAJ1
TLZE F,DSPTRL ;Trailer line need updating?
PUSHJ P,TRAILS ;Yes, do it
XCT DISPI ;PPINFO RBUF OR (for TTYs) JRST TDISP
MOVE T,RBUF+2
TLNE T,200000 ;ESC C (or similar) typed?
TRO F,DSPALL ;Yes, redraw everything
HLRZ T,RBUF+3+1 ;Get Y position for piece of paper 1
TRNE T,2000
IORI T,-2000
CAIN T,@DPPPOS ;Y position correct?
SOSE RBUF+1 ;Yes, PP 1 selected?
TROA F,DSPALL ;No, redraw everything and reposition PP
JRST DISP1
PUSH P,DSP ;DPYCHK clobbers this
PUSHJ P,DPYCHK ;Maybe he has changed terminals.
POP P,DSP
PUSHJ P,@PPSET ;Reposition PP
DISP1: MOVE H,[-DPYBSZ+1,,DPYBUF]
MOVE T,[2200,,RBUF-1]
MOVEM T,POSLST#
TRNN F,DSPALL
JRST @DISP1A
SKIPE DDACT
DPYOUT [0↔0]
DISP2: MOVE G,SCRTOP
PUSH H,POSWRD
IDPB H,POSLST
HRRZM H,DPYLOC(G)
; PUSHJ P,SETWN2 ;Reset line info in trailer line
; PUSHJ P,TRAILS ;Recalculate trailer line and page info
MOVE A,HEDBLK
MOVEI B,1
PUSHJ P,DBLT
MOVE B,ARRL
SUB B,TOPWIN
MOVE A,WINLIN
JUMPLE B,.+2
PUSHJ P,DBLT
TRNE F,ATTMOD
JRST DISPAT
XCT DISP2I
SKIPA T,AR2POS
MOVE T,ARRPOS
PUSH H,T
MOVE T,ARRON
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
;FALLS THRU
;DISP3, DISP4, DISP5, DUMMY, EXCLR, EXSET,EXTST
DISP3: TRNE F,EDITM
JRST DISP5
DISP3A: TLNE F,OFFEND
JRST [MOVE A,TRLBLK↔PUSHJ P,DBLT2↔JRST @DISPXA]
PUSHJ P,DBLT2
DISP4: MOVE B,BOTWIN
SUB B,ARRL
PUSHJ P,DBLT3
DISP4A: MOVE A,TRLBLK
PUSHJ P,DBLT
JRST @DISPXA
DISP5: PUSHJ P,LESET
XCT SPCOUT
PUSH H,[ASCID /
/]
HLLZS DPYTAB(G)
AOJ G,
HRRZM H,DPYLOC(G)
MOVEM G,DPYCLB#
MOVEI A,DUMMY
SKIPE B,EXTRA
PUSHJ P,DBLT
XCT SPCOUT
TLNE F,OFFEND
JRST @DISPXA
HRRZ A,@ARRLIN
JRST DISP4
LLDESC+1+2
DUMMY: .,,.
2,,0 ;Not-so-phony character counts
0,,-5 ;Phony flags and serial number
ASCID /
/
EXTST: XCT LETST
EXCLR: TDZA T,T
MOVEI T,1
EXSET: CAMN T,EXTRA
POPJ P,
MOVEM T,EXTRA#
TRO F,DSPSCR
MOVSI TT,WINBIT
SKIPE T,WINLIN
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
SETZM WINLIN
SETOM BOTWIN
JRST LINSET
;DISPAT, DISPAX
DISPAT: HRRZ A,ATTBUF#
MOVE B,ATTNUM#
CAILE B,ATTMAX
MOVEI B,ATTMAX/2
PUSH P,DBLTI
MOVE T,[JRST DBLT4]
MOVEM T,DBLTI
PUSH P,ARRPOS
MOVE T,ARPOS2
MOVEM T,ARRPOS
PUSHJ P,DBLT
MOVE T,ATTNUM
CAIG T,ATTMAX
JRST DISPAX
PUSH H,ARRPOS
MOVE T,[ASCID / . /]
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
PUSH H,[ASCID /. .
/]
AOJ G,
HRRZM H,DPYLOC(G)
MOVSI B,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN B,.-1
PUSHJ P,DBLT
DISPAX: POP P,ARRPOS
POP P,DBLTI
TLNE F,OFFEND
SKIPA A,TRLBLK
HRRZ A,ARRLIN
PUSHJ P,DBLT
TLNE F,OFFEND
JRST @DISPXA
JRST DISP4
;DDISPX DDSPX2 DDDONE WIPIT WIPL WIPL2
DDISPX: PUSHJ P,WIPIT
MOVE A,ARRL
ADD A,OFFSET
MOVEM A,OLDARR
DDSPX2: MOVEI T,
IDPB T,POSLST
PUSHJ P,DDCOP
JRST DDDONE
DPYOUT DPYHED
DPYOUT [0↔0]
DDDONE: PUSHJ P,LINREL
TRZ F,DSPSCR+DSPALL
SKIPE T,DPYCLB
HLLZS DPYTAB(T)
SETZM DPYCLB
JRST DISPX
WIPIT: MOVE T,G
SUB T,SCRTOP
SUB T,SCRSIZ
SUB T,BLNKL
ADDM T,BLNKL#
JUMPGE T,CPOPJ
HRL G,T
WIPL: MOVSI T,40
EXCH T,DPYTAB(G)
TLNN T,17700
JRST WIPL2
PUSH H,ARRPOS
WIPL2: PUSH H,[ASCID /
/]
AOBJN G,WIPL
POPJ P,
;DDCOP, DDLUZ, LINREL, LINRLL, IDISP, IDISP2
DDCOP: MOVEI TT,-DPYBUF(H)
CAIL TT,DPYBSZ/2-1
JRST DDLUZ
AOS T,H
HRLI H,DPYBUF+1
LSH T,1
SUBI T,DPYBUF+1
BLT H,-1(T)
SETZM (T)
SUBI T,DPYBUF-1
HRRZM T,DPYHED+1
POPJ P,
DDLUZ: SETZB TT,1(H)
SUBI H,DPYBUF-1-1
HRRZM H,DPYHED+1
JRST POPJ1
LINREL: MOVEI G,10000
MOVE T,[2200,,RBUF-1]
LINRLL: ILDB H,T
JUMPE H,CPOPJ
ADDI H,(TT)
ADDM G,(H)
JRST LINRLL
IDISP: TRNE F,DSPSCR
JRST DISP2
TRNE F,ATTMOD
JRST IDISP2
PUSHJ P,IIIARR
JRST POPBAJ
IDISP2: MOVE G,ARRL
ADD G,OFFSET
CAME G,OLDARR
JRST DISP2
JRST POPBAJ
;IIIARR, IIIAR2, IIIAR3
IIIARR: MOVE G,ARRL
ADD G,OFFSET
MOVEM G,OLDARR
TRNN F,EDITM!ATTMOD
JRST IIIAR2
TRNE F,ATTMOD
JRST [MOVNI G,20↔JRST IIIAR2]
PUSHJ P,LESET
JFCL
TLNE F,NULLIN
TLNE F,OFFEND
JRST IIIAR3
IIIAR2: PUSHJ P,PCOMPI
; TLOE F,ARRPG ;flushed because of displaying search page number
; JRST IIIAR4
MOVEM T,ARRBUF+1
MOVE T,ARRPOS
MOVEM T,ARRBUF+2
MOVE T,ARRON
MOVEM T,ARRBUF+3
DPYOUT 1,[ARRBUF↔5]
POPJ P,
;We are now editing a previously non-blank line on
; a III, so we need to quit displaying that line
; so that only the line editor will be there.
IIIAR3:
; TLZE F,ARRPG
PGSEL 0
HRRZ TT,DPYLOC(G)
MOVE T,[ASCID /
/]
UPGMVM T,1(TT)
HRRZ T,DPYLOC+1(G)
CAIN T,1(TT)
JRST IIIAR2
MOVSI T,1(T)
HRRI T,20
UPGMVM T,2(TT)
JRST IIIAR2
IFN 0,< ;flushed because of displaying search page number on POG 2
IIIAR4: UPGMVM T,ARRBUF+1
MOVE T,ARRON
CAME T,ARRBUF+3
UPGMVM T,ARRBUF+3
MOVEM T,ARRBUF+3
POPJ P,
>;0
;LESET, LEADJ, LECLR
;Note skip return
LESET: PUSHJ P,P2COMP
ADDI T,4000 ;This ensures a non-zero value without affecting position.
XCT LINTST ;Position Line Editor at bottom if whole line typed ahead.
SKIPE MACPNT ;Position LE at bottom of screen if expanding a macro.
MOVEI T,-1000
CAMN T,LEPOS
JRST POPJ1
MOVEM T,LEPOS#
LEYPOS (T)
TLNN F,NULLIN
AOSA (P)
INSKIP
POPJ P,
JRST POPJ1
LEADJ: SKIPE LEPOS
POPJ P,
MOVE G,ARRL
ADD G,OFFSET
PUSHJ P,LESET
POPJ P,
POPJ P,
LECLR: XCT LINTST ;Don't touch LE position if whole line typed ahead
SKIPE MACPNT ; nor if expanding a macro
POPJ P,
SKIPE LEPOS
LEYPOS
SETZM LEPOS
POPJ P,
;DBLT, DBLT1, DBLT2, DBLT3, IDISPX, DISPX, PPBAJ1, POPBAJ, POPAJ
DBLT: XCT DBLTI
JUMPE T,DBLT2
MOVE T,[ASCID / /]
DBLT1: PUSH H,ARRPOS
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
DBLT2: HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
HRRM T,DPYTAB(G)
HRRZ TT,-1(A)
SKIPGE TXTFLG(A) ;Was SKIPGE 1(A)
SUBI TT,2
CAMLE TT,LINMAX
HRRO TT,LINMAX
MOVSI T,LLDESC(A)
HRRI T,1(H)
ADDI H,-2-LLDESC(TT)
BLT T,(H)
JUMPGE TT,.+2
PUSH H,[ASCID /
/]
AOJ G,
HRRZ A,(A)
HRRZM H,DPYLOC(G)
DBLT3: SOJG B,DBLT
POPJ P,
DBLT4: MOVEI T,"|"*2+1
JRST DBLT1
IDISPX: PUSHJ P,IIIARR
TRZ F,DSPSCR+DSPALL
SETZM 1(H)
SUBI H,DPYBUF-1-1
HRRZM H,DPYHED+1
DISPX: DPYOUT DPYHED
JRST POPBAJ ;used to be TLZA F,ARRPG
PPBAJ1: AOS -2(P)
POPBAJ: POP P,B
POPAJ: POP P,A
POPJ P,
;PCOMPD, PCOMPI, PCOMPS, P2CMPD, P2CMPI
PCOMPD: MOVEI T,14
IMUL T,G
DPB T,[400400,,T]
TRZ T,17
ROT T,20
TRO T,<CW 4,0,4,0,5,0>
POPJ P,
PCOMPI: MOVE T,[-30⊗16]
IMUL T,G
ADD T,[BYTE(11)<-1000>,770(3)2,2(2)1,2(4)6]
POPJ P,
PCOMPS: PUSHJ P,PCOMPD
PUSH H,T
IDPB H,POSLST
POPJ P,
P2CMPD: MOVEI T,1(G)
LSH T,7
IDIV T,[-5]
ADDI T,1000
POPJ P,
P2CMPI: MOVEI T,(G)
IMUL T,[-30]
ADDI T,770
POPJ P,
;DDISP, DDISP2
DDISP: TRNE F,DSPSCR
JRST DDISPS
MOVE A,ARRL
ADD A,OFFSET
CAMN A,OLDARR
JRST DDISP2
TRNE F,ATTMOD
JRST DDISPS
EXCH A,OLDARR#
PUSH P,A
HRROI B,OFFARR
CAML A,OLDARR
HRROI B,ONARR
SUB A,OFFSET
PUSHJ P,FNDLIN
PUSH P,T
SKIPE DDACT
DPYOUT [0↔0]
PUSHJ P,DOARR
TRC B,OFFARR≠ONARR
PUSHJ P,DOARR
SUB P,[2,,2]
JRST DDSPX2
DDISP2: TRNN F,EDITM
JRST POPBAJ
SKIPE DDACT
DPYOUT [0↔0]
MOVE G,A
PUSHJ P,DOAR2
JRST POPBAJ
;DOARR, DOAR2, OFFARR, ONARR
DOARR: SKIPGE G,@(B)
POPJ P,
PUSHJ P,PCOMPS
TRNE F,EDITM
SKIPL 1(B)
SKIPA T,ARRPOS
MOVE T,AR2POS
PUSH H,T
MOVE T,@2(B)
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
MOVE A,@1(B)
TRNE F,EDITM
SKIPL 1(B)
AOJA B,DBLT2
DOAR2: PUSHJ P,LESET
PUSH H,[CW 1,46,1,46,1,46]
PUSH H,[ASCID /
/]
HLLZS DPYTAB(G)
AOJ G,
MOVEM G,DPYCLB
POPJ P,
OFFARR: ,-2(P) ;BOY DOES FAIL EVER EAT IT!
,-1(P)
[ASCID/ /]
ONARR: OLDARR
SETZ ARRLIN
ARRON
;DDISPS, DDSPS2, DDSPS3, DDSPSX, DDSPS4
DDISPS: SKIPE G,DPYCLB ;Do we need to redraw a special line?
HLLZS DPYTAB(G) ;Yes, force it out
SETZM DPYCLB ;Don't do it again
MOVE G,SCRTOP
PUSH P,C
PUSH P,D
SETOB C,D
SKIPE DDACT
DPYOUT [0↔0]
MOVE A,HEDBLK
HRROI B,[ASCID/ /]
PUSHJ P,DBLTS
MOVE C,ARRL
SUB C,TOPWIN
MOVE A,WINLIN
JUMPLE C,.+2
PUSHJ P,DBLTS
HRROI B,ARRON
TRNE F,EDITM!ATTMOD
JRST DDSPS4
DDSPS2: TLNE F,OFFEND
JRST DDSPSX
PUSHJ P,DBLTS
HRROI B,[ASCID / /]
DDSPS3: MOVE C,BOTWIN
SUB C,ARRL
PUSHJ P,DBLTS3
DDSPSX: MOVE A,TRLBLK
PUSHJ P,DBLTS
POP P,D
POP P,C
JRST DDISPX
DDSPS4: TRNE F,ATTMOD
JRST DSPSAT
PUSHJ P,LESET
SKIPA TT,ARRPOS
MOVE TT,AR2POS
PUSH P,TT
PUSH P,D
PUSHJ P,DBLTA
MOVEM G,DPYCLB
HRROI B,[ASCID / /]
SKIPE C,EXTRA
PUSHJ P,DBLTA
POP P,T
CAME T,D
PUSH H,[CW 1,46,1,46,1,46]
SUB P,[1,,1]
TLNE F,OFFEND
JRST DDSPSX
HRRZ A,(A)
JRST DDSPS3
;DSPSAT, DSPSAX
DSPSAT: HRRZ A,ATTBUF
MOVE C,ATTNUM
CAILE C,ATTMAX
MOVEI C,ATTMAX/2
HRROI B,["|"*2+1]
PUSHJ P,DBLTS
MOVE T,ATTNUM
CAIG T,ATTMAX
JRST DSPSAX
HRROI B,[ASCID / /]
MOVEI A,DOTS
PUSHJ P,DBLTS
MOVSI C,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN C,.-1
HRROI B,["|"*2+1]
PUSHJ P,DBLTS
DSPSAX: HRRZ A,ARRLIN
HRROI B,[ASCID / /]
JRST DDSPS2
;DBLTS, DBLTS2, DBLTSN, DBLTS3, DBLTS1, DBLTSA, DBLTA, DBLTA2
DBLTS: LDB T,[271000,,DPYTAB(G)]
CAIE T,@(B)
JRST DBLTS1
HRRZ T,TXTSER(A) ;!!!ALS MISSED THIS ONE -- WAS 2(A)--ME
CAIN T,@DPYTAB(G)
AOJA G,DBLTSN
CAIE G,(D)
PUSHJ P,PCOMPS
DBLTS2: PUSHJ P,DBLT2
AOJ B,
SKIPA D,G
DBLTSN: HRRZ A,(A)
DBLTS3: SOJG C,DBLTS
POPJ P,
DBLTS1: PUSHJ P,DBLTSA
PUSH H,ARRPOS
JRST DBLTS2
DBLTSA: CAIE G,(D)
PUSHJ P,PCOMPS
XCT @(P)
MOVE T,(B)
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
JRST POPJ1
DBLTA: LDB T,[271000,,DPYTAB(G)]
CAIN T,@(B)
AOJA G,DBLTA2
PUSHJ P,DBLTSA
PUSH H,-3(P)
PUSH H,[ASCID /
/]
AOS D,G
DBLTA2: HLLZS DPYTAB(G)
SOJG C,DBLTA
POPJ P,
;TDISP TDISP0 TDISP1 TDISP2 TDISP3 TDISPE
TDISP: PUSHJ P,TDISP0
TRZ F,DSPSCR!DSPALL
JRST POPBAJ
TDISP0: SETZM TYOPNT
PUSHJ P,GPAGL
HLRZ TT,T
ANDI T,-1
CAMN T,LSTPAG
JRST TDISP5
MOVEM T,LSTPAG
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /PAGE /]
TYPDEC LSTPAG
; OUTSTR [ASCIZ /
;/]
TDISP1: PUSHJ P,ABCRLF
MOVEM TT,LSTARR
TRNE F,EDITM
JRST TDISPE ;Here when entering text of line
MOVE A,ARRLIN
SKIPL T,TXTFLG(A) ;Was SKIPL T,1(A)
CAIN A,BOTSTR
JRST TDISP4
TYPDEC LSTARR
TYPCHR 11
HRRZ T,TXTCNT(A) ;New to permit TXTCNT≠TXTFLG
SKIPN T
TLOA A,350700
HRLI A,440700
ADDI A,LLDESC
TDISP2: ILDB T,A
TYPCHR (T)
CAIN T,11
JRST TDISP3 ;Skip to ending tab
CAIE T,12
JRST TDISP2
POPJ P, ;End of line
TDISP3: ILDB T,A
CAIE T,11
JRST TDISP3
JRST TDISP2
TDISPE: TYPDEC LSTARR ;Type out line number
TYPCHR ": " ;Thats a colon and a tab
POPJ P, ;Don't display the line he is about to type
;TDISP4 TDISP5 TYPE TYPEL TDISPM
TDISPM: OUTSTR [ASCIZ/ PAGEMARK)
/]
POPJ P,
TDISP4: TYPCHR "("
TYPDEC LSTARR
JUMPL T,TDISPM
OUTSTR [ASCIZ/ End of PAGE /]
TYPDEC LSTPAG
OUTSTR [ASCIZ/ of /]
TYPDEC PAGES
OUTSTR [ASCIZ/)
/]
POPJ P,
TDISP5: CAMN TT,LSTARR
TRNE F,DSPSCR!DSPALL
JRST TDISP1
POPJ P,
TYPE: TRNN F,ARG
IMULI A,=10
PUSHJ P,ARGCHK
SKIPG D,A
POPJ P,
TYPEL: PUSHJ P,TDISP0
MOVEI A,1
PUSHJ P,MOVARR
SOJG D,TYPEL
SKIPE DPY
POPJ P, ;Don't type out new current line if on dpy
PUSHJ P,TDISP0 ;Force out last line now
TRZ F,DSPSCR!DSPALL
POPJ P,
;WRPAGE, WRPAG1, WRPAG2, WRBOOK
;WRPAGE is entered whenever it is necessary to update the disk record.
;It is entered on specific command via CMDSP.
;PUSHJ entries are from FINISH: NEWPG0: FIND:
;JRST entry from DELET1:
WRPAGE: TRNE F,WRITE ;If page hasn't changed,
TRNE F,EDDIR ; or if we are editing the directory page,
JRST CLRWRT ;there is no output to do--just clear flags
TRNE F,REDNLY
JRST WRRDO ;Ask for confirmation of mode since page has changed
JFCL WRPAGE ;To report location WRPAGE in CHECKU
PUSHJ P,CHECKU
WRPAG1: SKIPN XDIRFG ;Has the directory been extended?
JRST WRPAG3
TRO F,UPDIR ;Yes, force output of updated directory
SETZM XDIRFG ; but don't do it again.
MOVEI T,1
MOVEM T,UFLAG
MOVEM T,UFLAG2 ;Clear " U" from top line.
WRPAG3: TRNE F,UPDTXT ;Has the text of the dir line for this page changed?
PUSHJ P,INSDIR ;Yes, get new dir line
TRNE F,UPDIR
PUSHJ P,DIRUP
SKIPE B,XPLST
PUSHJ P,DIRSET
MOVE A,CHARS
ADDI A,200*5-1
IDIVI A,200*5 ;Number of records needed to write out text
MOVEM A,NEWSIZ#
HRRZ C,@DIRPT
MOVE B,1(C) ;Record number of beginning of following page
HRRZ T,DIRP1 ;First page in core
SUB B,1(T) ;Calculate amount of disk space available
MOVEM B,OLDSIZ#
SUBI A,(B)
SKIPN DIRPAG
JRST WRPAG2 ;File has no disk directory
HRRZ TT,@DIR
MOVE TT,1(TT)
SOJ TT,
IMULI TT,200*5
CAMGE TT,DIRSIZ
JRST WRPX0 ;Directory needs additional record(s)--must expand
WRPAG2: JUMPLE A,WRPOK ;Jump if already enough disk space for text
MOVE TT,CURPAG
CAMGE TT,PAGES
JRST WRPX ;Must expand page(s) in middle of file--ripple
MOVEI TT,(A) ;Can expand page(s) at end of file by extending file
ADDB TT,DIREND+1 ;Increase record number of ENDMK by amt needed
SOJ TT,
CAMG TT,FILLEN
SKIPA TT,FILLEN
MOVEM TT,FILLEN ;Update number of records in file
LSH TT,7
MOVEM TT,FILWC ;Update number of words in file
IMULI A,200*5
ADDM A,ROOM
TRO F,UPDIR ;File longer means directory ENDMK must change
TRZ F,XPAGE
PUSHJ P,WRTIT ;Write out last page(s) of file
MTAPE DSKO,['GODMOD'↔17] ;Force retrieval out.
POPJ P,
IFN BOOKMD, {
WRBOOK: SORRY Cannot alter file when in BOOKMODE (/B).
POPJ P,
};END BOOKMD
;WRPX0 WRPX WRPX1 WRPX1A WRPX1B WRPX2 WRPXBP
;Here to auto burp a page.
WRPXBP: OUTSTR [ASCIZ/ Auto Burp:/]
;Here to recopy file in order to expand page(s) in the middle.
WRPX0: TRO F,XPAGE
WRPX: TRNN F,XPAGE
PUSHJ P,TELLZ
OUTSTR [ASCIZ / Rippling /]
IMULI A,200*5
ADDM A,ROOM
MOVEI I,1
SKIPN A,DIRPAG
JRST WRPX1A ;No directory on disk.
MOVE A,DIRSIZ
ADDI A,200*5-1+200*5
IDIVI A,200*5 ;Number of records dir need now
HRRZ B,@DIR
MOVE I,1(B) ;Number of records dir used to use
SUBI A,(I) ;Number of records by which whole file is shifted
MOVN C,DIRPAG
TRNN F,WRITE
JRST WRPX1B ;Only the directory will need different amt of disk
ADD C,CURPAG
JUMPLE C,WRPX1A
WRPX1: ADDM A,1(B) ;Shift record numbers of pages up to current page
HRRZ B,(B)
SOJG C,WRPX1
WRPX1A: ADD A,NEWSIZ ;Add in change in record size of current page
SUB A,OLDSIZ
HRRZ B,@DIRPT
HRL I,1(B) ;Old record number of following page
MOVN C,CURPAG
WRPX1B: ADD C,PAGES
WRPX2: ADDM A,1(B) ;Shift record numbers of pages beyond current page
HRRZ B,(B)
SOJGE C,WRPX2
;WRPX3, WRPX4
WRPX3: PUSHJ P,COPCOR ;Get a lot of extra core for coping file
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPENI
PUSHJ P,OPNLUZ
PUSH P,NEWSIZ
PUSHJ P,OUTDIR ;Write out the new directory
MOVEI E,EDFIL
SKIPN DIRPAG
PUSHJ P,OPENW ;OUTDIR opens output file for non /N case only
TRZ F,UPDIR+UPDTXT
POP P,NEWSIZ
MOVEI A,(I) ;Old record number of first page after dir
PUSHJ P,SETI ;Want to read from there
MOVEI A,(I) ;Old record number of first page after dir
TRNN F,WRITE
JRST WRPX4 ;No page changed (except dir)--do whole file at once
HRRZ B,DIR ;Get pointer to page 1 (directory page unless /N)
SKIPE DIRPAG ;/N?
HRRZ B,(B) ;No, get pointer to page after directory (page 2)
MOVE A,1(B) ;New record number of first page after dir
HRRZ B,DIRP1
SUB A,1(B) ;Subtract new record number of first page in core
ASH A,7
PUSHJ P,COPDAT ;Copy from old file to new
HRRZ T,DIRP1
PUSHJ P,WRTIT ;Write out current page
HLRZ A,I ;Former record number of following page
PUSHJ P,SETI ;Want to read old file from there
HLRZ A,I ;Former record number of following page
WRPX4: ASH A,7 ;Convert to words
SUB A,FILWC ;Make negative number of words to be written (Old WC)
SUBI A,200 ;Include first record of copy
;SUB A,DIREND+1 ;This caused garbage to be inserted if file ends middle of record
;ASH A,7
PUSHJ P,COPDO ;Copy remainder of file to new file and close both.
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPNOI ;Open new file for input.
PUSHJ P,TELLZ
TLZ F,ENTRD
MOVEI E,EDFIL
PUSHJ P,OPENW ;Open new file in R/A mode.
POPJ P,
;WRPOK, WRTIT, WRT0
WRPOK: SKIPL BURPEX ;Auto burping enabled?
JRST WRPOK2 ;No
CAMG A,BURPEX ;BURP if BURPEX is reached (on p. 244)
JRST WRPXBP ;Auto burp now, page is too bloated
WRPOK2: TRNE F,XPAGE ;Get here if don't need to ripple
JRST WRPX ;WANT TO RIPPLE ANYWAY
WRTIT: PUSH P,T ;Here to write out in-core page(s)
MOVEI E,EDFIL
PUSHJ P,OPENW
SKIPN DIRPAG
TRZ F,UPDIR
TRNE F,UPDIR
TRNE F,XPAGE
JRST WRT0
MOVE D,ODSIZ
CAIL D,200*5+3 ; ;-CR-LF
SKIPA D,[170700,,DRIV2+3]
MOVE D,[170700,,DRIV1+3]
MOVEM D,INPNT
MOVE C,PAGES
PUSHJ P,NUM5
MOVEI A,1
PUSHJ P,SETO
MOVE C,-3-1(D)
MOVEI D,
OUTPUT DSKO,C
WRT0: HRRZ A,DIRP1
MOVE A,1(A)
PUSH P,A
PUSHJ P,SETO
MOVEI A,PAGE
MOVEI DSP,WRDSP
MOVSI E,LSPC+NSPEC
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVE T,FIRPAG
SOJE T,WRLINE
;WRP1 WRLINE WRLUP WRLP2 WRRDO WRRDO2 WRRDO3 WRRLUZ
WRP1: MOVEI C,14
IDPB C,G
AOBJN B,WRLINE
PUSHJ P,WRBUF
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
WRLINE: HRRZ A,(A)
CAIN A,BOTSTR
JRST WRDONE
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A)
JRST WRPM
MOVEI D,LLDESC(A)
HRRZ T,TXTCNT(A)
TRNN T,777777
TLOA D,350700
HRLI D,440700
HRRI B,
WRLUP: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,G
WRLP2: AOBJN B,WRLUP
PUSHJ P,WRBUF
MOVE G,OPNT
MOVN T,OCNT
HRLI B,(T)
JRST WRLUP
WRRDO:
IFN BOOKMD, {
SKIPE BOOKSW
JRST WRBOOK ;DONT EVER WRITE A BOOK
};END BOOKMD
TRNE F,FILLUZ
JRST WRRLUZ ;File not formatted
SORRY PAGE HAS BEEN ALTERED -- PLEASE REAFFIRM MODE.
WRRDO2: MOVE E,[-NMCMDS,,MCMDS]
PUSHJ P,EXTEN1
JRST WRRDO3
PUSHJ P,(D)
TRNE F,REDNLY
JRST CLRWRT
JRST WRPAG1
WRRDO3: OUTSTR [ASCIZ /READONLY OR READWRITE: /]
JRST WRRDO2
WRRLUZ: PUSHJ P,ABCRLF
OUTSTR [ASCIZ ⊗*** Text changes were not written out--file is not formatted. ***
⊗]
JRST CLRWRT
;WRDSP, WRTAB, WRCHK, WRDONE, WRDON2
WRDSP: JRST WRLINE
PUSHJ P,TELL1
JFCL
MOVEI D, ;KILL NEXT ILDB
JRST WRTAB
PUSHJ P,TELL5
PUSHJ P,TELL6
WRTAB: IDPB C,G
HRROI C,-10
IORI C,(B)
SUB B,C
ADD D,BTAB2+10(C)
JUMPGE D,.+2
ADD D,[XOR 1]
SOJA B,WRLP2
WRCHK: LDB E,[370300,,G] ;SEE HOW MANY CHARS WE WROTE (FROM BLK -C(T))
ADD T,OBLK
LSH T,7
ADDI T,-OBUF+1(G)
IMULI T,5
SUB T,BTAB(E)
POPJ P,
WRDONE: POP P,T
SUB P,[1,,1]
MOVNI T,(T)
PUSHJ P,WRCHK
CAME T,CHARS
PUSHJ P,FATFIX ;A temporary FATAL ERROR fix on page 73
MOVEM G,OPNT
PUSHJ P,CLOSO
MOVN T,NEWSIZ
TRNN F,XPAGE ;BEWARE OF SHRINKING BUBBLE
ADD T,OLDSIZ
JUMPLE T,WRDON2
MOVE A,[OBUF-1,,OBUF]
BLT A,OBUF+177
PUSHJ P,WRBUF ;Write out records of nulls at end of current page
SOJG T,.-1
WRDON2: HRRZ T,@DIRPT
HRRZ T,1(T)
CAME T,OBLK
PUSHJ P,FATFI2 ;A temporary FATAL ERROR fix on page 73
TRNE F,UPDIR+UPDTXT
PUSHJ P,OUTDIR
JRST CLRWRT
;WRPM, BTAB2
WRPM: HRRZ B,-1(P)
MOVN T,1(B)
PUSHJ P,WRCHK
LDB C,[341000,,LLDESC+LPMTXT+1(A)]
IMULI C,200*5
LDB E,[221200,,LLDESC+LPMTXT+1(A)]
ADDI C,(E)
CAIE T,(C)
PUSHJ P,TELLZ
MOVEM G,OPNT
PUSHJ P,CLOSO
MOVE T,-1(P)
HRRZ T,(T)
MOVE C,OBLK
CAME C,1(T)
PUSHJ P,TELLZ
MOVEM T,-1(P)
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVSI E,LSPC+NSPEC
JRST WRP1
BTAB2: -340000,,1
-250000,,1
-160000,,1
-70000,,1
1
-340000,,
-250000,,
-160000,,
IMPURE
DEFINE INV!(X,Y){-L!X,,.
X: ASCII /COMMENT ⊗ INVALID XXXXX PAGES
Y
/
IFN <.-X>&1,<0> ;SUPER-WINNING CHANNEL
L!X←←.-X}
INV DRIV1,<⊗;>
INV DRIV2,THE REST OF THIS PAGE IS GARBAGE
PURE
;FLSPAG, FLSPGL, FLSPG2, CLRWRT, CLRWR2, DSHED
FLSPAG: TRNE F,UPDIR
PUSHJ P,DIRFIX
; TRNE F,REDNLY!EDDIR
; SETZM ATTLOC
SKIPN C,LINES
JRST FLSPG2
HRRZ B,PAGE
TLO F,NOCHK
FLSPGL: MOVEI A,(B)
HRRZ B,(B)
PUSHJ P,FSGIVE
SOJG C,FLSPGL
FLSPG2: TLZ F,NOCHK
SETZM ARRLIN
SETZM WINLIN
SETZM XPAGES
SETZM XPLST
SETZM XCHRS
HRRZS BOTSTR+TXTFLG
CLRWRT: TRZN F,WRITE+UPDIR+UPDTXT+XPAGE
POPJ P,
CLRWR2: MOVEI T,1
MOVEM T,WFLAG
MOVEM T,WFLAG2
TLO F,DSPTRL ;Force recalculation of trailer values
DSHED: MOVE T,SCRTOP ;Force redisplay of header line
HLLZS DPYTAB(T)
TRO F,DSPSCR
POPJ P,
;TV, RSYS, RUN, RUN1
FILWRD←←0 ;FOR PASSING RETURN FILNAM, ETC.
DEVWRD←←6 ;" (NOTE THIS STUFF IS SAME PLACE AS SYS PUTS IT)
TV: MOVE T,[440700,,[ASCIZ /TV/]]
MOVEM T,EXTPNT
RSYS: SKIPA T,['SYS ']
RUN: MOVSI T,'DSK'
MOVEM T,RUNFIL-1
MOVE T,EXTPNT
MOVEM T,TYIPNT
MOVE T,[MOVEI C,15]
MOVEM T,TYIINS
SETZM RUNFIL
MOVSI T,'DMP'
MOVEM T,RUNFIL+1
MOVE T,PPN
MOVEM T,RUNFIL+3
MOVE D,[SETZ RUNFIL]
PUSHJ P,FRD0
JRST RUNILL
TLNE D,FRDNAM
JRST RUN1
SKIPN RPGACS+FILWRD
JRST RUNNON
SKIPE T,RPGACS+DEVWRD
MOVEM T,RUNFIL-1
MOVE T,[RPGACS+FILWRD,,RUNFIL]
BLT T,RUNFIL+1
MOVE T,RPGACS+FILWRD+3
TLNN T,77
JRST RUN1
TRNE T,77
MOVEM T,RUNFIL+3
RUN1: MOVE T,[RUNFIL-1,,LKUP-1]
MOVEI C,SWP
PUSHJ P,OPNDEV ;skips on failure
LOOKUP SWP,LKUP
JRST RUNFNF
MOVE T,EDFIL
MOVEM T,RPGFIL
HLLZ T,EDFIL+1
TRNE F,REDNLY
TRO T,200000
SKIPN DIRPAG
TRO T,100000
MOVEM T,RPGEXT
MOVE T,EDFIL+3
CAMN T,PPN
MOVEI T,
MOVEM T,RPGPPN
PUSHJ P,GPAGL
HRRZM T,RPGPAG
HRR T,ATTNUM
TRNE F,ATTMOD
IORI T,400000 ;Flag attach mode to new program
TRNE F,EDITM
HRR T,EDCNM ;Give column position to new program
MOVSM T,RPGLIN
TRZE F,ATTMOD
PUSHJ P,ATTEX
PUSHJ P,FINISH
MOVE T,[RUNFIL,,RPGACS+FILWRD]
BLT T,RPGACS+FILWRD+3
MOVE T,RUNFIL-1
MOVEM T,RPGACS+DEVWRD
MOVSI 17,RPGACS
BLT 17,17
MOVEI A,RUNDEV
SWAP A,
PUSHJ P,TELLZ
;RUNILL, RUNNON, RUNFNF, RUNDEV, RUNFIL
RUNILL: SORRY ILLEGAL FILE SPECIFICATION.
JRST POPJ1
RUNNON: SORRY I HAVEN'T ANYPLACE TO RETURN TO.
JRST POPJ1
RUNFNF: TLNN D,FRDNAM
JRST RUNNON
PUSHJ P,FILERR
RELEAS SWP,
OUTSTR [ASCIZ /
/]
JRST POPJ1
IMPURE
0
RUNDEV: 0
RUNFIL: BLOCK 2
1
0
PURE
;SEARCH ROUTINES
;FLAGS
SDELIM←←1
SBKWDS←←2
SEXACT←←4
OFFPAG←←10
;DATA BLOCKS, E will contain FNDTBF (for 1 page) or FNDBUF (fon multipage)
SRCFLG←←0 ;Indexed by E to contain search string flag
SRCSIZ←←1 ; to contain search string size
SRCBUF←←2 ; to contain search string start
SUBFLG←←40 ;Indexed by E to contain substitution string flag
SUBSIZ←←41 ; to contain substitution string size
SUBTYP←←42 ; to contain type of associated search
SUBDEL←←43 ; to contain delete command string
;Cell reserved for deletion string overflow
SRFLG2←←45 ; To contain saved value of SRFLG for repeat
SUBBUF←←46 ; to contain substitution string start
SUBDIF←←SUBBUF-SRCBUF ;To permit simple stepping from SRCBUF to SUBBUF
;FREE STORAGE MACROS
DEFINE GETFS(X)
{ SKIPN X,@SFSPNT
PUSHJ P,SFSGT
EXCH X,SFSPNT}
DEFINE RETFS(X)
{ EXCH X,SFSPNT
HRRZM X,@SFSPNT}
SFSNUM←←8
;OPERATOR CODES
NOTOP←←2
INFOP←←3
OROP←←5
ANDOP←←6
BINOP←←7
ENDOP←←7
CROP←←10
CLOSOP←←11
ORCHR←←12
ANDCHR←←13
SGBBIT←←400000
SGEBIT←←200000
NLDBIT←←100000
NOTBT←←2000
XFRSAV←←4
INDTST←←5
REMTST←←10
LSBLK←←5
;SREAD SREAD0 SREAD1 SREAD2 SREAD3 SREAD4 SRSTOR SRSTR2 QREAD QREADX QREADY QRACT QRACT2 QABORT
;Called by FINDIT (page 175) and FIND (page 176) to read string from TTY
;String is assembled in BUF and must be shorter than 199 characters
SREAD: HRRZM C,SAVEFX#
HRLM B,SAVEFX ;Save temporarily for later test and possible save
PUSH P,F ;Save copy of EDITM bit
TRZ F,EDITM ;Force DISP to redraw current line if from line ed.
SKIPE TYIPNT ;Skip if reading from TTY.
JRST SREAD0 ;Reading from XFIND command string.
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding a macro.
PUSHJ P,DISP ;Update display, including line we came from, if any
XCT LINTST
SREAD0: POP P,T ;Get back EDITM flag
ANDI T,EDITM ; and nothing else
CAIN B,3
TRO T,SDELIM
JUMPGE A,.+2
TRO T,SBKWDS
MOVEM T,SRFLG#
MOVMM A,SRCNT#
MOVE D,[440700,,BUF]
MOVNI B,SRSIZ*5-1
SETZM SRCSI2# ;Count non-text chars ¬ and ≡ for substitution
SETZM IDFLAG# ;To keep track of meaning of ¬ and ≡
TLZ F,TF1 ;String not (yet) delimited by LF's
PUSHJ P,TYI
JRST SREAD4 ;Find out the cause of activation
SREAD1: IDPB C,D
SKIPN IDFLAG
JRST SREAD9 ;Nothing special seen last
SKIPL IDFLAG
JRST SREAD8 ;Last seen ≡ means this char is normal text (quoted)
CAIE C,"≡" ;Last seen ¬
JRST SREAD8 ;This is a text char (negated)
HLRZS IDFLAG ;0,,-1 means have seen quoting ≡ ("¬≡x")
JRST SREAD7
SREA10: HLLOS IDFLAG ;0,,-1 means have seen quoting ≡
JRST SREAD7
SREA11: SETOM IDFLAG ;-1 means have seen negating ¬
SREAD7: AOSA SRCSI2 ;Count a non-text char in string
SREAD8: SETZM IDFLAG
JRST SREAD2
SREAD9: CAIN C,"≡"
JRST SREA10
CAIN C,"¬"
JRST SREA11
SREAD2: PUSHJ P,TYI
JRST SRACT ;Now act on extended string
SREAD3: AOJN B,SREAD1
SORRY SEARCH STRING TOO LONG.
SETZB D,SRCNT
AOS -1(P)
JRST SREAD2
;SREAD4 is called if an activation character is recieved before any characters.
;and it allows for ALT interruption. On a LF it returns to
;SREAD2 (with TF1 set in F) to allow for reading of additional TTY input.
;A "\" with bucky bits as the first character causes a transfer to QREADR which
;then permits a repetition of an old substitution request providing that
;SUBFLG(E) has not been reset to zero by the receipt of a new search command
;without an acceptable new substitution string. Any other activation character
;causes SREAD5 to be entered.
SREAD4: PUSHJ P,BEEPS1 ;Finished reading argument (unless substitution).
CAIN C,175
JRST POPTJ ;An ALT abort
LDB TT,[POINT 7,C,35]
CAIE TT,"∞"
CAIN TT,"\"
JRST QREADR ;This means repeat last substitution
CAIL TT,"0"
CAILE TT,"9"
SKIPA
JRST QREADR ;Argument for a repeat substitution
SETZM QCHR ;Definitely not a substitution
;put another saveguard in here
CAIE C,12
JRST SREAD5
TLO F,TF1
SKIPN TYIPNT ;Skip if not reading from TTY
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding macro
SOJA B,SREAD2
;SRSTOR stores the searched-for string away.
SRSTOR: JUMPLE D,SRSTR2
MOVEI TT,
IDPB TT,D
TLNE D,760000
JRST .-2
MOVSI TT,BUF
HRRI TT,SRCBUF(E)
SUBI D,BUF
ADDI D,(TT)
BLT TT,(D)
ADDI B,SRSIZ*5-1+1
MOVEM B,SRCSIZ(E)
SRSTR2: SETZM SUBTYP(E) ;Will be reloaded from SAVEFX for a substitution
SETZM SUBFLG(E) ;A new substitution string must be given
JUMPN D,.+2
MOVEI E,SRDUMY
SETZM QCHR ;This may also be a simple FIND so fix this also
JRST (Q)
;Entered from SRACT on the receipt of a \ as the first string termination
;QREAD sets up a 9-bit character string, an argument and delete command based on
;the size of the search string. This is stored at SUBDEL(E). Then the code accepts
;the substitution string and stores this temporarily in BUF. On the receipt of an
;activation character,the code then JRST's to QRACT, the string goes to SUBBUF(E),
;SAVEFX goes to SUBTYP(E), and QCHR and SUBFLG(E) ars set as requested
;by the activating character that terminates the substitution string.
QREAD: MOVEM A,QARG#
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding a macro
LDB B,[70200,,C]
MOVEM B,SUBTMP# ;Save bucky bits temporarily
MOVEI A,0
MOVEM A,SUBDEL(E) ;To guarentee termination
MOVEM A,SUBDEL+1(E) ;To guarentee termination
MOVE A,[POINT 9,SUBDEL(E)] ;We shift to 9-bit representation
MOVE D,[POINT 9,SUBDEL(E)]
MOVE T,SRCSIZ(E) ;Get size of searched-for string to set up deletes
SUB T,SRCSI2 ; The ¬ symbols do not count
HRLZM T,SUBSIZ(E) ;actual number to delete put in left half
SOJN T,QREADY ;Leave one delete until later for LINE-EDIT case
MOVEI C,240 ;Just to be sure we enter LINE-EDITOR properly
IDPB C,D
MOVEI C,377
IDPB C,D ;Sure to be at first charaacter now
JRST QREADX
QREADY: PUSHJ P,NUMSTR
MOVEI C,0
IDPB C,A ;Temporary termination for number
;Now add CONTROL bits to this number
ILDB C,D
JUMPE C,.+4 ;Test for end of number
ADDI C,200 ;Add CONTROL bit
DPB C,D
JRST .-4
MOVEI C,304 ; Delete symbol replaces the temporary termination
DPB C,D
QREADX: MOVEI C,311 ;Readying the INSERT symbol
IDPB C,D
MOVEI C,0
IDPB C,D ;Now add final termination
IDPB C,D ;And an extra one for good measure
;Now read in the substitution string
QREAD0: MOVE D,[POINT 7,BUF] ;Go back to 7-bit for this
MOVNI B,SRSIZ*5-1 ;To count substitution characters
TLZ F,TF1
PUSHJ P,TYI
JRST QREAD4 ;Find out the cause of activation
QREAD1: IDPB C,D
QREAD2: PUSHJ P,TYI
JRST QRACT ;Now act on substitution string
QREAD3: AOJN B,QREAD1
SORRY <Substitution string is too long.
Type termination character or <ALT> to abort.>
SETZB D,SRCNT
AOS -1(P)
JRST QREAD2
;We get here if trying a substitution while in attach mode
QRDATT: SUB P,[1,,1] ;Flush return from SREAD
MOVEI A,ILLAT1 ;Address of msg: IN ATTACH MODE
JRST ILLMS2 ;Type out error message
;Entered from QREAD if first character is an activator.
QREAD4: PUSHJ P,BEEPS1 ;Finished reading argument.
ANDI C,377 ;Clear β bit
CAIN C,175
JRST POPTJ ;Still not too late to abort voluntarily.
TRNE F,ATTMOD
JRST QRDATT ;Substitution is illegal in attach mode.
CAIE C,15
CAIN C,"\"
JRST QRED4A
CAIN C,215 ;May want LINE-EDIT case
JRST QRED4A
QABORT: SORRY Illegal activation character--Substitution ABORTED.
SUB P,[1,,1]
JRST POPJ1
QRED4A: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Type Y to confirm your NULL substitution request? /]
PUSHJ P,YESCHK
JRST QRED4B
CLRBFI
OUTSTR [ASCIZ /Type corrected substitution string or type <ALT> to abort.
/]
JRST QREAD0
QRED4B: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Making only one NULL substitution initially. Please use repeat request.
/]
TRNN C,200 ;Is it a α<cr> case?
SOJA B,QRACT2 ;A false count has been made
SOJA B,QRA2
;We only get here if there is a substitution string.
QRACT: PUSHJ P,BEEPS1 ;Finished reading argument.
MOVEI A,0
TRZ F,ARG
QRACT0: LDB TT,[POINT 7,C,35]
CAIN TT,"∞"
JRST [MOVEI A,377776↔JRST QRA0]
CAIL TT,"0"
CAILE TT,"9"
JRST QRACT1
IMULI A,=10
ADDI A,-"0"(TT)
QRA0: TRO F,ARG
QRACT4: PUSHJ P,TYI
JRST QRACT0
JRST QRACT0
QRACT1: PUSHJ P,BEEPS1 ;Finished reading argument.
LDB TT,[POINT 7,C,35]
CAIN TT,175 ;Still not too late to abort voluntarily.
JRST POPTJ
TRNE F,ATTMOD
JRST QRDATT ;Substitution is illegal in attach mode.
CAIE TT,"\"
CAIN TT,15
JRST QRA1
JRST QABORT ;Illegal activation character--abort.
QRA1: CAIN C,600!"\"
MOVEI C,15 ;αβ\ at end of substitute string means CR.
TRZN F,ARG
JRST QRACT2
CAILE A,377776 ;Was CAILE A,144
MOVEI A,377776 ;Was MOVEI A,144 ;Limit before requesting confirmation
MOVNS A
HRLZS A
CAIN C,15
JRST QRACT3
OUTSTR [ASCIZ/ ARGUMENT IGNORED! You can abort substitution with <ALT> /]
JRST QRA2 ;Force αCR (for αCR, αβCR, βCR, α\, β\)
QRACT2: MOVE A,SUBONE ;The correct value for QCHR if not ∞ or <CONT><CR>
CAIN C,200!"\" ;Accept α\ for αCR
QRA2: MOVEI C,215
CAIN C,215 ;Is command a <CONTROL><CR> ?
MOVEI A,1 ;This forces a LINE-EDIT type substitution
QRACT3:
MOVEM E,SAVEE# ;It is now time to reset SAVEE
MOVEM A,QCHR ;Set priming word for proper code entry
MOVEM A,SUBFLG(E) ;Arm the substitution buffer space
TRZ F,ARG!REL ;Not wanted if a substitution
MOVEI TT,
IDPB TT,D ;Terminate the string
TLNE D,760000 ;Pad out with nulls
JRST .-2
MOVSI TT,BUF
HRRI TT,SUBBUF(E)
SUBI D,BUF
ADDI D,(TT)
BLT TT,(D) ;Store string away in SUBBUF(E)
ADDI B,SRSIZ*5-1+1 ;To get insertion count
HRRM B,SUBSIZ(E) ;Must not bother deletion count in left half
MOVE TT,SAVEFX
MOVEM TT,SUBTYP(E) ;Validate type of search
JRST SREAD6
;This code is entered from SREAD4 when a \, ∞, or a # (with activation bits) is the
;first character showing that no new string is to be typed. This is NOT ACCEPTABLE.
QREADR: SORRY Not an acceptable command without a searched-for string.
JRST POPTJ
;QREADN: SORRY <No proper substitution string or an improper request.
;Substitution aborted. You must now retype entire command.>
; SETZM QCHR ;Better be safe
; TLZ F,OKF
; JRST POPTJ
;SRACT SREAD5 SRALT SRALT2 SRALUZ SREDT ASTER BSLAS BSLXCT BSLXC2 SREAD5 SREAD6
SRCLUZ:
; POP P,E
; IOR F,E ;Restore proper real flags
SUB P,[2,,2] ;Don't return to search command routine
JRST POPJ2 ;Go execute error routine immediately
SRACT: PUSHJ P,BEEPS1 ;Finished reading argument.
TLNE F,TF1
JRST SRALT
JSP Q,SRSTOR
SREAD5: LDB TT,[POINT 7,C,35]
CAIN TT,"\"
JRST QREAD
SETZM QCHR ;Safety measure to inhibit substitution
SREAD6: TRZ F,ARG!REL!NEG
MOVEI DSP,CMDSP
MOVEI A,
PUSH P,E
;The following kludge has been replaced by a better one using TF1 flag.
; MOVSI E,NULLIN!OFFEND!PMLIN ;Clear these flags for now, saving old values
; AND E,F
; PUSH P,E
; TLZ F,NULLIN!OFFEND!PMLIN
PUSHJ P,CMDEXS ;Get dispatch word for activator into D
JRST SRCLUZ ;Illegal command
; POP P,E
; IOR F,E ;Restore values of flags cleared for CMDEX
POP P,E
MOVE T,SRFLG
MOVEM D,SDSP#
MOVEM A,SARG#
HRLI C,(B)
MOVEM C,SCHR#
TLNE D,SACMD
JRST .+3
TLNE D,SSCMD
XCT -1(D)
MOVEM T,SRFLG ;This seems to get clobbered during search
MOVEM T,SRFLG2(E) ;Save separately to replace for repeat
TRNN T,EDITM
POPJ P,
MOVE A,ARRLIN
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
MOVEM T,SRCNUM
MOVE T,EDCNM
HRRZM T,SRCOFF ;Make search start from col where command was given
POPJ P,
SRALT: CAIN C,15
JRST SREAD3
CAIN C,175
JRST POPTJ
CAIE C,12
JRST SRALUZ
JSP Q,SRSTOR
SRALT2: PUSHJ P,TYI
JRST SREAD5
JRST SRALT2
SRALUZ: MOVEM C,COMCHR
JRST POPTJ
;Repeats the last FIND command (whether single or multipaged)
;If <CONTROL>* one is left in the line editor.
;IF <META><CONTROL>* one is left at (but not in) the found line.
;A new argument may be specified.
ASTER: SKIPN E,SAVEF ;To see what was the last command
JRST ASTERX ;Woops, not properly primed.
MOVEM A,SRCNT ;Set count of number to find
MOVEM A,SRCN1 ;and also this counter.
MOVEI TT,EDITM
TRNN F,EDITM ;Did we come from within a line?
ANDCAB TT,SRFLG2(E) ;No, turn off EDITM in search flags
TRZE F,EDITM ;Did we come from within a line?
IORB TT,SRFLG2(E) ;Yes, turn on EDITM in search flags
MOVEM TT,SRFLG
TRNN F,ATTMOD ;Interpret as <META><CONTROL> always if in ATTACH
CAIE B,1
MOVEI B,0
MOVEI C,15
TRZ F,ARG!REL!NEG ;We don't want these on.
MOVE D,CRDSP ;Fix for desired terminating condition (plain CR)
CAIE B,0
MOVE D,CRDSP+1 ;Dispatch word for αCR
MOVEI A,1
MOVE T,SRFLG
MOVEM D,SDSP
MOVEM A,SARG
HRLI C,(B)
MOVEM C,SCHR
TLNE D,SACMD
JRST .+3
TLNE D,SSCMD
XCT -1(D)
MOVEM T,SRFLG
TRNN T,EDITM
JRST ASTER2
MOVE A,ARRLIN
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
MOVEM T,SRCNUM ;Save this
; MOVSI T,1
; MOVEM T,SRCOFF ;Make it non-zero for CTRL-CR
MOVE T,EDCNM
HRRZM T,SRCOFF
ASTER2: MOVEI A,1
MOVE D,SDSP
CAIN E,FNDTBF
JRST FNDBSL ;A single page command
CAIN E,FNDBUF
JRST ASTER3
ASTERX: SORRY Repeat-find command not properly primed.
SETZM SAVEF ;Guard against another try
JRST POPJ1
ASTER3: SETZM ESCIEN ;No ESCAPE I typed yet.
SETZM ESCI2 ;Haven't been interrupted.
TRO F,DSPSCR ;Force display of header line to erase search page number
JRST FINBSL
;This code responds to the \ command.
;<CONTROL>\ accepts the last substitution (if still unconfirmed) and goes
;on to show the next one using the slow LINE-EDIT mode which permits one to
;cancel the substitution by an ALT.
;<META><CONTROL>\ accepts the last unconfirmed substitution and makes
;a fast substitution. This command will accept an argument and then make the
;requested number of substitutions if there are that many available.
;It should be noted that only the last substitution (F or XF) is remembered.
;One can interpose an ordinary FIND command of the opposite type without
;obliterating the record of the remembered substitution (with entry via SAVEE).
BSLAS: MOVE E,SAVEE
SKIPE SUBTYP(E) ;Are we primed for a repeat?
SKIPN SUBFLG(E)
JRST BLAS1 ;Alas, no
SETZM ESCIEN ;User hasn't typed ESC I yet.
SETZM ESCI2 ;Haven't been interrupted yet.
TRO F,DSPSCR ;Update screen after search to erase page number
MOVEI TT,EDITM
TRNN F,EDITM ;Did we come from within a line?
ANDCAB TT,SRFLG2(E) ;No, turn off EDITM in search flags
TRZE F,EDITM ;Did we come from within a line?
IORB TT,SRFLG2(E) ;Yes, turn on EDITM in search flags
MOVEM TT,SRFLG
CAIE B,1
MOVEI B,0
MOVEI C,15
TRZ F,ARG!REL!NEG
BLASX: CAIE B,0
CAILE A,1
JRST BLAS0
MOVEI A,1
MOVE D,CRDSP+1 ;Dispatch word for αCR
JRST BLAS3
BLAS0: MOVEI B,0
CAIG A,1
JRST BLAS2
CAILE A,377776
MOVEI A,377776
MOVNS A
HRLZS A
SKIPA
BLAS2: MOVE A,SUBONE
MOVE D,CRDSP ;Dispatch word for plain CR
BLAS3: MOVEM A,QCHR
MOVEM A,SUBFLG(E)
MOVEI A,1
MOVE T,SRFLG
MOVEM D,SDSP
MOVEM A,SARG
HRLI C,(B)
MOVEM C,SCHR
TLNE D,SACMD
JRST .+3
TLNE D,SSCMD
XCT -1(D)
MOVEM T,SRFLG
TRNN T,EDITM
JRST BLAS4
MOVE A,ARRLIN
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
MOVEM T,SRCNUM
; MOVSI T,1
; MOVEM T,SRCOFF ;Make it non-zero for CTRL-CR
MOVE T,EDCNM
HRRZM T,SRCOFF
BLAS4: MOVEI A,1
MOVE D,SDSP
CAIN E,FNDBUF
JRST FINBSL ;Go to the X routine
CAIN E,FNDTBF
JRST FNDBSL ;Go to the page-only routine
BLAS1: SORRY Repeat-substitute command is not properly primed.
SETZM QCHR
SETZM SUBFLG(E)
SETZM SUBTYP(E)
JRST POPJ1C
;This is the code that actually does the substitution in EDGL if QCHR
;is positive. It must also be armed by having a positive value in SUBFLG(E).
BSLXCT: MOVE E,SAVEE
SKIPLE SUBFLG(E) ;This must be ≥0 for a legal substitution
JRST BSLXC2
OUTSTR [ASCIZ /
WOOPS! the system goofed! but it is all right, ETV was on the job.
/]
SETZM QCHR ;Disarm
POPJ P, ;and forget it.
BSLXC2: MOVEI TT,SUBDEL(E)
TLOA TT,441100 ;MAKE A BYTE POINTER
IDPB C,D ;PUT INTO TYPE-AHEAD BUFFER
ILDB C,TT
JUMPN C,.-2
MOVEI TT,SUBBUF(E)
TLOA TT,440700 ;MAKE A BYTE POINTER
IDPB C,D ;PUT INTO TYPE-AHEAD BUFFER
ILDB C,TT
JUMPN C,.-2
MOVEI C,304 ;CTRL D
IDPB C,D
MOVEI C,377 ;CTRL BS
IDPB C,D
SKIPE IMLACL
SORRY Line editor type substitution not implemented for Imlacs.
SKIPN IMLACL
BSLXC3: PUSHJ P,SUBSAY ;To type message and return
JFCL ;SUBSAY skip returns now
SETZM QCHR ;We do not want to go around again
POPJ P,
;FINDIT FOUND FNDMOV FNDERR SUBSTP SUBERR FND2 FND2A SETJMP SUBSP3 SUBSP2 FNDER2 FNDER3 FNDER5
;FINDIT is called by the F command (single page search)
FINDIT:
; SETZM TYIPNT
MOVEI E,FNDTBF
MOVEM E,SAVEF# ;Save for a possible * repeat
PUSHJ P,SREAD ;To read string in from TTY (on page 173)
FNDBSL: MOVE TT,SRFLG2(E)
MOVEM TT,SRFLG
PUSHJ P,SCOMP
FNDBS2: PUSHJ P,SRCPAG
JRST FNDERR ;Not found
FOUND: PUSHJ P,SPFIN
PUSHJ P,SFLUSH
FND2: MOVE D,SDSP
FND2A: HLRZ B,SCHR ;Come here from MSG6 with D set up
HRRZ C,SCHR
MOVE A,SARG
TRNE F,ARG
TRNE F,REL
TLNN D,SACMD
JRST FNDMOV
TRON F,ARG!REL
MOVEI A,
TLNE D,SSCMD
XCT -1(D)
SUB A,ARRL
ADD A,SRCL
SKIPN QCHR
JRST POPJ2 ;Normal FIND exit
;Here we have a substitution to do.
TLZ F,OKF ;Override FW's kludge to say OK for plain CR on find
MOVEM A,LSTARG
HRLM F,LSTARG ;To preserve REL!NEG flags
MOVEM D,LSTCOM
MOVE B,ARRL
FND3: ADD A,ARRL
PUSHJ P,SETJMP ;Set arrow on line; center line in window if needed.
JRST SUBSTR
SETJMP: PUSH P,A
PUSH P,B
PUSHJ P,SETARR ;Set arrow to specified line.
HRRZ B,BOTWIN ;If BOTWIN is -1, pretend it is infinity.
CAML A,TOPWIN
CAIL A,(B) ;BOTWIN marks star or dash line (but might be -1).
PUSHJ P,JMPJMP ;Center line in window.
JRST POPBAJ
FNDMOV: JUMPGE D,.+2
TRNN F,REL
SKIPA A,SRCL
ADD A,SRCL
PUSHJ P,SETJMP ;Set arrow on line; center line in window if needed.
MOVE A,SARG
; MOVSI T,1 ;To insure entry into LINE EDITOR
; IORM T,SRCOFF ;Only right half is used to count
HRRZ T,SRCOFF
TLNE D,EDOK*10
MOVEM T,EDMOV
JRST POPJ2 ;This will leave us in the LINE-EDITOR
FNDERR: SKIPE ESCI2 ;Have we been interrupted by ESC I?
JRST FNDER3 ;Yes
SKIPE QCHR
JRST SUBERR
MOVE T,SRCNT
CAME T,SRCN1
JRST FNDER4
; SKIPA T,[[ASCIZ /NOT FOUND ENOUGH -- /]]
MOVEI T,[ASCIZ /NOT FOUND -- \/]
FNDER2: PUSHJ P,ABCRL0 ;Type CRLF but preserve T.
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR (T)
CAIA
FNDER3: OUTSTR [ASCIZ / while searching for \/]
FNDER5: SETZM ESCI2
MOVE B,SDATA
ADDI B,SRCBUF
OUTSTR (B)
OUTSTR [ASCIZ /\
/]
PUSHJ P,MACSTP ;Terminate macro expansion.
PUSHJ P,SFLUSH
SETZM COMCHR
JRST POPJ1C
FNDER4: PUSHJ P,ABCRL0 ;Type CRLF but preserve T.
OUTSTR [ASCIZ /Found only /]
SUB T,SRCN1
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ / instead of /]
MOVE T,SRCNT
TYPDEC T
OUTSTR [ASCIZ / examples,/]
JRST FNDER3
;This message appears at end of a repeating substitution execution.
SUBERR: PUSHJ P,SUBER1
JFCL ;SUBER1 skips.
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
SUBER1: MOVE B,SDATA
ADDI B,SRCBUF
PUSHJ P,SFLUSH
SUBSTP: SETZM QCHR
SETZM TYOPNT
MOVE E,SAVEE
PUSHJ P,ABCRLF ;Type CRLF (clobbers T)
MOVE T,SUBFLG(E)
HRRZ TT,T
CAIE T,1
CAMN T,SUBONE
SKIPA
JUMPG TT,SUBSP2
OUTSTR [ASCIZ/Not found, trying to replace \/]
JRST SUBSP3
SUBSP2: OUTSTR [ASCIZ /After /]
TYPDEC TT
OUTSTR [ASCIZ / replacements of \/]
SUBSP3: OUTSTR (B)
OUTSTR [ASCIZ /\ with \/]
ADDI B,SUBDIF ;To get to SUBBUF
OUTSTR (B)
OUTSTR [ASCIZ /\. /]
JRST POPJ1C
;FIND
FIND: SETZM ESCIEN ;User hasn't typed ESC I yet.
SETZM ESCI2 ;Haven't been interrupted yet.
MOVE T,EXTPNT
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
MOVEI E,FNDBUF
MOVEM E,SAVEF ;Save for a possible * repeat
PUSHJ P,SREAD ;Read search string.
TRO F,DSPSCR ;Force redisplay of header text (for DD).
FINBSL: MOVE TT,SRFLG2(E)
MOVEM TT,SRFLG
SETZM TYIPNT
PUSHJ P,SCOMP
FINBS2: TRNE F,SBKWDS
SKIPA T,[SCONTB]
MOVEI T,SCONTF
PUSHJ P,SRCPG1
JRST FNDERR
TRZN G,OFFPAG
JRST FOUND
EXCH G
MOVEI D,-SBKDSP(G)
IDIVI D,3
HLLZ D,BTAB3(D)
HRRI D,@SBKNWA
MOVEM D,SCLOB#
MOVE D,IBLK
MOVE T,SDIRPT
SUBI D,@1(T)
MOVEM D,TSTBLK
PUSHJ P,SFLUSH
PUSHJ P,WRPAGE
PUSHJ P,FLSPAG
MOVE A,SRCPG
PUSHJ P,FNDPAG
HRRZ T,1(T)
ADDM T,TSTBLK
MOVEI T,SSET
MOVEM T,TSTSET
PUSHJ P,NEWPG1
SKIPA B,[400]
JSP SARRGH
PUSHJ P,FSGET
HRRM A,SCXCT
MOVEI T,-1(T)
MOVEM T,SFSLST
MOVEM F,SSAVF
EXCH F,SRFLG
MOVE D,[SRCPGB,,SRCPGF]
MOVEM D,SRCTYP
MOVEI T,SBKNL
HRRM T,SBKNW
MOVE A,SRCL
PUSHJ P,FNDLIN
MOVE A,SRCLIN
MOVEM T,SRCLIN
ADDI A,(T)
MOVEI E,
PUSHJ P,SCNBAK
PUSHJ P,SPFIN
EXCH F,SRFLG
HRRZ A,SCXCT
PUSHJ P,FSGIVE
MOVN A,GTDEL
;ME ASH A,-1 ;ME--now we center the line found
ADD A,SRCL
PUSHJ P,SETWIN
JRST FND2
;DIRSRC DIRSR2 DFERR SRCDF SDFCR
DIRSRC: SETOM LBLFOO# ;Flag not from label search
DIRSR2: SUB P,[1,,1]
MOVE D,F
TRNE D,NEG
TRZ D,REL
ANDI D,REL ;Relative (positive) command searches from next page
MOVEM D,DIRREL#
SETZM TYIPNT
TRZ T,SBKWDS
MOVEM T,SRFLG
MOVEI D,CPOPJ
MOVEM D,SDSP
PUSHJ P,SCOMP
MOVEI D,SRCDF
PUSHJ P,SRCSET
MOVEI T,1
SKIPE DIRREL
ADD T,CURPAG ;Searching dir from next page
MOVEM T,SRCPG
HRRZ A,DIR
SKIPE DIRREL
HRRZ A,@DIRPT ;Relative command looks at dir starting at next page
CAIN A,DIREND
JRST DFERR ;No pages to search
MOVEM A,SRCLIN
ADD A,[440700,,LPDESC]
ILDB C,A
MOVEI D,3
PUSHJ P,SCALL
JRST DFERR
MOVE A,SRCPG
EXCH F,SRFLG
PUSHJ P,NEWPG5 ;Get to line 1 of proper page, maybe already in core
SKIPA B,SCHR
JSP SARRGH
SKIPL LBLFOO ;Doing label search?
JRST LBLSR2 ;Yes
TLNN B,2
JRST SFLSH1
EXCH F,SRFLG
MOVEI T,2
MOVEM T,SRCN1
SETOM SRCOFF ;No search string found yet.
PUSHJ P,SRCPAG
JRST .+2 ;Didn't find 2 occurrences
JRST FOUND
MOVEI T,[ASCIZ /Found only once on page indicated by directory -- \/]
SOSLE SRCN1
MOVEI T,[ASCIZ /Not found on page indicated by directory (HUH?) -- \/]
JRST FNDER2
DFERR: MOVEI T,[ASCIZ /Not in directory -- \/]
SKIPE DIRREL
MOVEI T,[ASCIZ /Not found hereafter in directory -- \/]
JRST FNDER2
SRCDF: 15↔JSP SDFCR
0↔JSP SARRGH
177↔JSP SARRGH
SDFCR: HRRZ A,@SRCLIN
CAIN A,DIREND
JRST SRCHLX
MOVEM A,SRCLIN
AOS SRCPG
ADD A,[350700,,LPDESC]
LDB C,A
JRST @
;SSET, SSET2
SSET: SETZM TSTBLK
LDB C,SCLOB
MOVEM C,SRCOFF
MOVEI C,177
DPB C,SCLOB
MOVEI C,SSET2
MOVEM C,RLDA
POPJ P,
SSET2: MOVE C,LINES
ADDI C,1
MOVEM C,SRCL
MOVE C,E
IBP C
SUBI C,(A)
MOVEM C,SRCLIN
MOVEI C,RLD
MOVEM C,RLDA
POP P,C
HRLI C,SRCOFF
JRA C,-2(C)
SCONTB: JSP SBARF
;SCOMP SFLUSH NOSRCH SFLSH1 SFLSL
;Called by FINDIT (page 175), FIND (page 176) and DIRSRC (page177)
SCOMP: MOVEM P,SSAVP#
MOVEM F,SSAVF#
MOVEM E,SDATA#
MOVEI T,[0]
MOVEM T,SFSPNT#
SETZM SFSLST#
HLLZS VBBITS
MOVE B,SRCSIZ(E)
ADDI B,1
MOVE T,SRFLG
TRNE T,SDELIM
ADDI B,2
LSH B,1
EXCH F,SRFLG
IOR F,SRCFLG(E)
PUSHJ P,SFSGET
JSP TT,SFSPUT
TRNE F,SEXACT
TDZA TT,TT
SKIPA TT,[377777777000]
TDZA T,T
MOVSI T,LETF
MOVEM T,SLMODE#
MOVEM TT,SLMOD2#
SKIPE A,SRCNT
PUSHJ P,SPARSE
JUMPE A,NOSRCH
PUSHJ P,SGRAPH
PUSHJ P,SBACK
JRST SCGEN
SFLUSH: EXCH F,SRFLG
SFLSH1: SETZM SFSPNT
TLO F,NOCHK
SKIPA A,SFSLST
SFLSL: MOVEI A,(C)
HLRZ C,(A)
HRRZ T,(A)
SUBI A,-2(T)
PUSHJ P,FSGIVE
JUMPN C,SFLSL
TLZ F,NOCHK
MOVE T,[PUSHJ P,UUOH]
MOVEM T,41
POPJ P,
NOSRCH: OUTSTR [ASCIZ /NULL SEARCH NOT EXECUTED
/]
JRST SBARF2
;SBARF, SBARF1, SARRGH, SFSGT, SFSGET, SFSPUT, SFSPTL
SBARFI: OUTSTR [ASCIZ /SEARCH TERMINATED BY <ESC>I
/] ↔ CAIA
SBARF: OUTSTR [ASCIZ /SEARCH STRING TOO COMPLEX.
/]
SUBI 1
SBARF1: MOVEM SBADR#
SBARF2: MOVE F,SSAVF
MOVE P,SSAVP
SUB P,[1,,1]
SKIPN T,FSEND1
JRST .+3
MOVEM T,FSEND
PUSHJ P,ENDFIX
PUSHJ P,SFLSH1
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
SARRGH: OUTSTR [ASCIZ /INTERNAL SEARCH LOSSAGE.
/]
SOJA SBARF1
SFSGT: FOR X IN(A,B,T,TT){PUSH P,X↔}
MOVNI T,2
ADDM T,-4(P)
CAML P,[-10,,PDL-1+LPDL-10]
JSP SBARF
MOVEI B,SFSNUM*2
PUSHJ P,SFSGET
JSP TT,SFSPUT
FOR X IN(TT,T,B,A){POP P,X↔}
POPJ P,
SFSGET: EXCH F,SRFLG
PUSHJ P,FSGET
EXCH F,SRFLG
HRLI T,LOKBIT
HLLM T,-1(A)
MOVEI T,-1(T)
EXCH T,SFSLST
HRLM T,@SFSLST
POPJ P,
SFSPUT: LSH B,-1
SKIPA T,A
SFSPTL: HRRZM T,-2(T)
ADDI T,2
SOJG B,SFSPTL
EXCH A,SFSPNT
HRRZM A,-2(T)
JRST (TT)
;SPARSE
SPARSE: MOVSI A,440700
HRRI A,SRCBUF(E)
MOVSI H,NSPEC!SSP1
SETZM SLEV#
TRNE F,SBKWDS
SKIPA T,[HRRM B,(G)]
SKIPA T,[HLRM G,(B)]
SKIPA TT,[MOVS G,G]
MOVSI TT,(<JFCL>)
MOVEM T,SSLINK#
MOVEM TT,SSSWAP#
MOVEI DSP,SSCDSP
MOVEI Q,ENDOP
PUSHJ P,SPARS1
CAIN Q,ENDOP
SKIPE SLEV
PUSHJ P,TELLZ
MOVEI A,(G)
TRNN F,SDELIM
POPJ P,
JUMPE A,CPOPJ
GETFS T
MOVE A,[1,,VBBITS]
HLLZM A,(T)
HRRZM A,1(T)
HLRZ TT,G
HRRM T,(TT)
GETFS T
HRRZM A,1(T)
HLRE TT,(G)
JUMPL TT,.+2
ADDI TT,200
ANDI TT,¬77
HRLI G,1(TT)
MOVEM G,(T)
MOVEI A,(T)
POPJ P,
;SPARS1, SPARS2, SPDSP, SSCAN, SSCANA, SSCANX
SPARS1: HRLM Q,(P)
PUSHJ P,SSCAN
SPARS2: HLRZ D,(P)
CAIG Q,(D)
POPJ P,
PUSH P,G
PUSHJ P,SPARS1
POP P,T
HRLI T,(G)
GETFS G
HRLI G,(G)
MOVSM T,1(G)
HLRZ T,(T)
LSH T,-6
CAIE T,(E)
SETOB T,E
LSH T,6
XCT SPDSP-BINOP(D)
HRLZM T,(G)
JRST SPARS2
SPDSP: PUSHJ P,TELLZ
IORI T,OROP
PUSHJ P,TELLZ
IORI T,OROP
IORI T,ANDOP
SSCAN: SETZB E,G
PUSHJ P,SSCAN1
CAIL Q,BINOP
POPJ P,
JUMPE G,.-3
MOVS B,G
SSCANA: ANDI T,¬77
ADDI E,(T)
PUSHJ P,SSCAN1
CAIL Q,BINOP
JRST SSCANX
JUMPE G,.-3
XCT SSLINK
HRRI B,(G)
JRST SSCANA
SSCANX: HLR G,B
XCT SSSWAP
LSH E,-6
DPB E,[301400,,(G)]
JUMPGE T,CPOPJ
IORM T,(G)
POPJ P,
;SSCAN1, SSCN1A, SSCN1B, SSCQT, SSCBIN, SSCINF, SSCNOT, SSCUOP, SSCVB
SSCAN1: ILDB C,A
TDNE H,CTAB(C)
XCT @CTAB(C)
SSCN1A: MOVEI Q,
SSCN1B: MOVEI T,100
GETFS G
HRLI G,(G)
HRLZM Q,(G)
MOVEM C,1(G)
POPJ P,
SSCQT: ILDB C,A
JUMPN C,SSCN1A
SSCBIN: LDB Q,[270400,,@CTAB(C)]
POPJ P,
SSCINF: MOVEI Q,INFOP+400000
MOVSI T,-100
ILDB C,A
CAIN C,"∞"
AOJA Q,SSCUOP
JRST 2,@[20000,,SSCUOP]
SSCNOT: MOVEI Q,NOTOP
SSCUOP: HRLM Q,(P)
PUSHJ P,SSCAN1
CAIL Q,BINOP
POPJ P,
ANDI T,¬77
TSO T,(G)
HRLM T,(G)
HLRE Q,(P)
JUMPGE Q,.+4
ANDI Q,77
JUMPE G,.+2
MOVEI T,-100
MOVEI TT,(G)
GETFS G
HRLI G,(G)
MOVEM TT,1(G)
ANDI T,¬77
IORI T,(Q)
HRLZM T,(G)
POPJ P,
SSCVB: MOVEI C,VBBITS
MOVEI Q,1
JRST SSCN1B
;SSCLP, SSCDSP
SSCLP: AOS SLEV
MOVSI H,NSPEC!SSP1!SSP2
MOVEI Q,CLOSOP
HRLM E,(P)
PUSH P,B
PUSHJ P,SPARS1
POP P,B
HLRE E,(P)
SOSG SLEV
MOVSI H,NSPEC!SSP1
CAIE Q,CLOSOP
ADD A,[70000,,]
SKIPN Q,G
TDZA T,T
LDB Q,[220600,,(G)]
XCT SSSWAP
POPJ P,
SSCDSP: JUMPA ENDOP,SSCBIN
PUSHJ P,TELL1
JUMPA CROP,SSCBIN
PUSHJ P,TELL3
PUSHJ P,TELL4
JRST SSCAN1
REPEAT 12-6,{PUSHJ P,TELLZ}
JUMPA ANDCHR,SSCBIN
JRST SSCNOT
JRST SSCLP
JUMPA CLOSOP,SSCBIN
MOVSI C,NOTBT
JRST SSCQT
JUMPA ORCHR,SSCBIN
JRST SSCINF
JRST SSCVB
FACNT←←174
FABITS: FACNT,,
377537,,-20
-20
-20
-40
;SGRAPH, SGRPH1, SGRPH2, SGRPHX, SGDO1, SGDO1X, SGDOX2, SGDSP, SGDO1B
SGRAPH: SETZM SSVNUM#
SETZM SSVMAX#
PUSHJ P,SGDO1
JUMPE B,CPOPJ
HRLM B,(P)
SGRPH1: HLRZ C,B
PUSHJ P,SGDO1
JUMPE B,SGRPHX
SGRPH2: MOVSI T,SGEBIT
ANDCAM T,1(C)
HRRZ TT,(C)
HRRM B,(C)
HRLM C,(B)
JUMPE TT,SGRPH1
MOVEI C,(TT)
; PUSHJ P,SGDUP
JRST SGRPH2
SGRPHX: MOVSI B,(C)
HLR B,(P)
POPJ P,
SGDO1: SKIPN B,A
POPJ P,
HRRZ A,(A)
LDB T,[220600,,(B)]
XCT SGDSP(T)
SGDO1X: IORB T,1(B)
SGDOX2: LDB TT,[301400,,(B)]
SETZM (B)
HRLI B,(B)
TLNN T,NOTBT
POPJ P,
AOS T,SSVNUM
CAMLE T,SSVMAX
MOVEM T,SSVMAX
DPB T,[221100,,1(B)]
POPJ P,
SGDSP: MOVSI T,SGEBIT
JRST SGDO1B
JRST SGNOT
REPEAT 4,{JSP SBARF}
SGDO1B: AOS T,SSVNUM
CAMLE T,SSVMAX
MOVEM T,SSVMAX
MOVSI T,SGEBIT!1000(T)
JRST SGDO1X
;SGNOT
SGNOT: HRLM A,(P)
HRRZ A,1(B)
RETFS B
PUSHJ P,SGDO1
HLRZ A,(P)
JUMPE B,CPOPJ
CAIE TT,1
JSP SBARF
MOVSI T,NOTBT
XORB T,1(B)
TLNE T,NOTBT
JRST SGDOX2
HLRZ T,T
ANDI T,777
CAMN T,SSVMAX
SOS SSVMAX
SOS SSVNUM
MOVSI T,777
ANDCAM T,1(B)
JRST SGDOX2
;SBACK, SBACK1, SBACK2, SBACK3, SBACK4
SBACK: HRRZM B,SGPNT#
HLRZ A,B
MOVEI C,SGEND#
MOVSI T,INDTST⊗9
HLLOM T,SBLST+1
SETZM SGECNT#
SBACK1: GETFS T
HRRZM T,(C)
AOS SGECNT
MOVEI C,(T)
MOVEI B,(A)
SKIPL 1(B)
JRST .+4
HLRZ B,(B)
HRRZ T,1(B)
JUMPN T,.-2
HRLI A,(B)
MOVEM A,(C)
SETZM 1(C)
HRL C,(A)
PUSH P,C
PUSHJ P,SBCALC
PUSHJ P,[TLZN B,NLDBIT↔HLRZ B,(B)↔HLRZ G,(C)↔POPJ P,]
PUSHJ P,TELLZ
SKIPGE 1(B)
HRRZ B,(B)
HLRZ A,(C)
HRRZM A,1(C)
HRRM B,(A)
IORM B,(A)
HRRZ C,(C)
SBACK2: PUSHJ P,SBCALC
MOVEI G,(C)
JRST SBACK4
HLRZ T,(C)
SKIPGE 1(C)
JRST SBBRCH
SBACK3: SKIPGE 1(B)
HRR B,(B)
HRLM B,(C)
ANDCMI B,-1
IORM B,1(C)
SKIPE C,T
JRST SBACK2
SBACK4: POP P,C
HLRZ A,C
JUMPN A,SBACK1
SETZM (C)
POPJ P,
;SBBRCH, SBBR2
SBBRCH: SKIPN A,T
TROA A,SGPNT
SKIPL 1(A)
JRST SBBR2
SKIPA A,(A)
HLRZ A,(A)
HRRZ TT,(A)
CAIE TT,(C)
JRST .-3
SBBR2: HRRZ TT,(C)
HRRM TT,(A)
MOVEI A,(C)
HRRZ C,1(C)
RETFS A
JRST SBACK3
;SBCALC, SBCAL0, SBCAL1, SBCAL2, SBCAL3
SBCALC: SETZM SBLST
SKIPGE T,1(C)
JRST SBCBP
TLC T,NOTBT
SBCAL0: MOVEM T,SBTST#
HLRZ B,(C)
MOVSI D,(C)
HRRI D,SBLST1
SETZM SBLST1#
JUMPE B,SBCNON
HLRZ A,(B)
MOVEI B,(C)
TLZ F,TF1
SBCAL1: JUMPE A,SBCAL3
HLRZ G,(C)
MOVEI H,(A)
SBCAL2: JSP E,SCCOM
JRST SBCLUZ
JRST SBCCB
JRST SBCCB
SKIPA T,1(H)
SBCL2A: MOVE T,1(H)
TLNE T,777
TLO F,TF1
HLRZ G,(G)
HLRZ H,(H)
JUMPN H,SBCAL2
SBCAL3: MOVEI G,SBTST-1
HLRZ H,(B)
JSP E,SCCOM
JRST SBCLUZ
JRST SBCAL4
JRST SBCAL4
SKIPA T,1(H)
MOVE T,1(H)
TLNN T,777
JRST SBCX
;FALLS THRU TO SBCAL4
;SBCAL4, SBCNON, SBCX, SBCOPL, SBCOP2, SBCEND, SBCEN2, SBCFIX, SBCFXL, SBCFXE, POPJ2
SBCAL4: MOVEI B,(H)
TLOA B,NLDBIT
SBCNON: HRRZ B,SGPNT
SBCX: XCT @(P)
TLZN F,TF1
JRST SBCEND
HLRZ H,(B)
JUMPE H,SBCEND
TLNE B,NLDBIT
HLRZ G,(G)
SBCOPL: MOVE T,1(H)
TLNN T,777
JRST SBCOP2
TLZ T,¬777
TLO T,XFRSAV⊗9
IOR T,B
HRRI T,(G)
GETFS TT
HRRZM B,(TT)
MOVEM T,1(TT)
MOVEI B,(TT)
SBCOP2: HLRZ G,(G)
HLRZ H,(H)
JUMPN H,SBCOPL
SBCEND: SKIPN SBLST1
JRST SBCOK
TLNE B,NLDBIT
JRST SBCEN1
HRRM B,(D)
SBCEN2: MOVE B,SBLST1
SKIPN T,SBLST
MOVEI T,SBLST
SBCFIX: HLLZ TT,B
SBCFXL: LDB G,[3700,,1(T)]
CAML G,[INDTST⊗9,,]
TRNN G,-1
JRST SBCFXE
HRLM B,(T)
IORM TT,1(T)
HRRZ T,(T)
JUMPN T,SBCFXL
SBCFXE: HRRM B,SBLST
HLRZ B,D
SKIPE SBLST1
JRST SBCNXT
HLRZ B,SBLST
POPJ2: POP P,T
JRST 2(T)
;SBCOK, SBCEN1, SBCLUZ, SBCLZ1, SBCNXT, SBCBP, SBCBPL
SBCOK: SKIPN T,SBLST
JRST POPJ2
JRST SBCFIX
SBCEN1: GETFS T
HRLZM B,(T)
MOVSI B,INDTST⊗9!NLDBIT
MOVEM B,1(T)
HRRM T,(D)
JRST SBCEN2
SBCLUZ: SKIPN T,SBLST1
JRST SBCNXT
SBCLZ1: HRRZ TT,(T)
RETFS T
SKIPE T,TT
JRST SBCLZ1
SBCNXT: HLRZ B,(B)
MOVSI D,(B)
HRRI D,SBLST1
SETZM SBLST1
JUMPE B,SBCNON
HLRZ A,(B)
JUMPE A,SBCNON
HLRZ A,(A)
JRST SBCAL1
SBCBP: MOVSI T,-1
ADDB T,1(C)
TLNE T,777
JRST POPJ1
MOVE A,[FABITS+1,,SBBUF]
BLT A,SBBUF+3
SKIPA G,(C)
SBCBPL: MOVEI G,(T)
PUSHJ P,MAKBIT
ANDCAM TT,SBBUF(T)
HLRZ T,(G)
CAIE T,(C)
JRST SBCBPL
HRRM G,1(C)
MOVSI T,SGBBIT
ANDCAM T,1(G)
MOVE T,[1000,,SBBUF-1]
JRST SBCAL0
;SBCCB, SBCCB1, SBCCB2, SBCCB8, SBCCB3, SBCCB4, SBCCB5
SBCCB: EXCH G,H
PUSHJ P,MAKBIT
MOVEM TT,BITBF1(T)
EXCH G,H
PUSHJ P,MAKBIT
ANDM TT,BITBF1(T)
SKIPN T,SBLST
JRST SBCCB3
LDB E,[221100,,1(G)]
JUMPN E,.+2
JSP SARRGH
PUSH P,G
HLRZ T,T
SBCCB1: LDB TT,[330400,,1(T)]
CAIGE TT,INDTST
JRST SBCCB8
MOVEI G,(T)
SBCCB2: LDB T,[221100,,1(G)]
CAIE T,(E)
JRST .+3
PUSHJ P,MAKBIT
ANDCAM TT,BITBF1(T)
HRRZ T,(G)
JUMPN T,SBCCB1
SBCCB8: HLRZ G,(G)
JUMPN G,SBCCB2
POP P,G
SBCCB3: MOVEI E,BITBF1-1
PUSHJ P,BITCNT
JUMPE T,SBCLUZ
CAIN T,1
JRST SBCCB7
CAIN T,2
JRST SBCCB6
SBCCB4: MOVSI E,INDTST⊗9
HRRI E,(H)
SBCCB5: GETFS T
HRRM T,(D)
HRRI D,(T)
SETZM (D)
LDB T,[221100,,1(G)]
TLO E,(T)
MOVEM E,1(D)
JRST SBCL2A
;SBCCB6, SBCCB7, BITCNT, BITCN1
SBCCB6: SKIPE TT,3(E)
CAME TT,4(E)
JRST SBCCB4
TDNN TT,SLMOD2
JRST SBCCB4
SBCCB7: PUSHJ P,NEWBTC
TLO E,REMTST⊗9
JRST SBCCB5
BITCNT: SKIPE T,1(E)
PUSHJ P,BITCN1
PUSH P,T
SKIPE T,2(E)
PUSHJ P,BITCN1
ADD T,(P)
IDIVI T,77
MOVEM TT,(P)
SKIPE T,3(E)
PUSHJ P,BITCN1
PUSH P,T
SKIPE T,4(E)
PUSHJ P,BITCN1
POP P,TT
ADD T,TT
IDIVI T,77
POP P,T
ADD T,TT
POPJ P,
BITCN1: MOVE TT,T
LSH TT,-1
AND TT,[333333333333]
SUB T,TT
LSH TT,-1
AND TT,[333333333333]
SUBB T,TT
LSH TT,-3
ADD T,TT
AND T,[70707070707]
POPJ P,
;NEWBIT, NEWBT0, NEWBT1, NEWBT2, NEWBT3, NEWBT4, NEWBT5
NEWBIT: CAIG T,2
JRST NEWBTC
CAIL T,FACNT-2
JRST NEWBNC
NEWBT0: HRLI E,T
PUSH P,E
PUSH P,T
HRRI E,VBBITS
NEWBT1: HLRZ TT,(E)
CAME TT,(P)
JRST NEWBT2
MOVE T,[-4,,1]
MOVE TT,@E
CAMN TT,@-1(P)
AOBJN T,.-2
JUMPGE T,NEWBT4
HLRZ TT,(E)
NEWBT2: ADD TT,(P)
CAIE TT,FACNT
JRST NEWBT3
MOVE T,[-4,,1]
MOVE TT,FABITS(T)
ANDCM TT,@E
CAMN TT,@-1(P)
AOBJN T,.-3
JUMPGE T,[HRLI E,NOTBT!1000↔JRST NEWBT5]
NEWBT3: HRR E,(E)
TRNE E,-1
JRST NEWBT1
PUSH P,A
PUSH P,B
MOVEI B,6
PUSHJ P,SFSGET
MOVEI E,(A)
HRRZ A,VBBITS
HRRM E,VBBITS
HRRZM A,(E)
POP P,B
POP P,A
MOVE T,(P)
HRLM T,(E)
MOVEI T,1
MOVSI T,@-1(P)
HRRI T,1(E)
BLT T,4(E)
SETZM 5(E)
NEWBT4: HRLI E,1000
NEWBT5: SUB P,[2,,2]
POPJ P,
;NEWBTC, NEWBC1, NEWBC2, NEWBC3, NEWBNC, NEWBN1, NEWBN2, NEWBN3, NEWBCZ, NEWBNZ
NEWBTC: JUMPE T,NEWBCZ
CAIE T,2
JRST NEWBC1
SKIPE TT,3(E)
CAME TT,4(E)
JRST NEWBT0
TDNN TT,SLMOD2
JRST NEWBT0
NEWBC1: HRLI E,-4
SKIPE T,1(E)
JFFO T,NEWBC2
AOBJN E,.-2
JSP SARRGH
NEWBC2: HLRZ E,E
NEWBC3: HRRI E,4(E)
LSH E,5
ADDI E,(TT)
POPJ P,
NEWBNC: CAIL T,FACNT
JRST NEWBNZ
CAIE T,FACNT-2
JRST NEWBN1
MOVE TT,FABITS+3
ANDCM TT,3(E)
JUMPE TT,NEWBT0
TDNN TT,SLMOD2
JRST NEWBT0
XOR TT,4(E)
CAME TT,FABITS+4
JRST NEWBT0
NEWBN1: HRLI E,E
PUSH P,E
MOVE E,[-4,,1]
NEWBN2: MOVE T,FABITS(E)
ANDCM T,@(P)
JFFO T,NEWBN3
AOBJN E,NEWBN2
JSP SARRGH
NEWBN3: SUB P,[1,,1]
HRRI E,NOTBT⊗-5
MOVS E,E
JRST NEWBC3
NEWBCZ: TDZA E,E
NEWBNZ: MOVSI E,NOTBT
POPJ P,
;SCCOM, SCCNOT
SCCOM: HLLZ T,1(G)
HLR T,1(H)
TDNE T,[405000,,405000]
JRST SCCBIT
MOVE T,1(G)
XOR T,1(H)
TDNN T,[NOTBT,,-1]
JRST 4(E)
MOVE TT,1(G)
HLR TT,CTAB(TT)
TLNE T,NOTBT
JRST SCCNOT
TSNN TT,SLMODE
JRST .+3
TRNN T,¬40
JRST 4(E)
TLNN TT,NOTBT
JRST (E)
HRRZ TT,1(G)
JUMPE TT,2(E)
HRRZ TT,1(H)
JUMPE TT,3(E)
JRST 1(E)
SCCNOT: TSNE TT,SLMODE
TRNE T,¬40
TRNN T,-1
JRST (E)
TLNE TT,NOTBT
JRST 2(E)
JRST 3(E)
;SCCBIT
SCCBIT: PUSHJ P,MAKBIT
MOVEM TT,BITBF1(T)
EXCH G,H
PUSHJ P,MAKBIT
MOVEM TT,BITBF2(T)
EXCH G,H
MOVSI T,-4
MOVE TT,BITBF1(T)
TDNN TT,BITBF2(T)
AOBJN T,.-2
JUMPGE T,(E)
MOVSI T,-4
SETCM TT,BITBF1(T)
TDNN TT,BITBF2(T)
AOBJN T,.-2
JUMPL T,.+2
ADDI E,1
MOVSI T,-4
SETCM TT,BITBF2(T)
TDNN TT,BITBF1(T)
AOBJN T,.-2
JUMPGE T,3(E)
JRST 1(E)
;MAKBIT, MAKBT0, MAKBT1, MAKBTN, MAKBN2, MAKBTB, MAKBB3
MAKBIT: SKIPGE 1(G)
JRST MAKBBT
MAKBT0: LDB T,[330300,,1(G)]
XCT MBDSP(T)
SKIPG @(P)
JRST MAKBT1
MOVSI T,-4
XCT @(P)
AOBJN T,.-1
MAKBT1: HRRZ T,1(G)
LDB TT,[360100,,CTAB(T)]
ROTC T,-5
ROT TT,5
MOVE TT,BITTAB(TT)
MAKBTX: TDNN T,SLMODE
POPJ P,
XCT @(P)
XORI T,1
POPJ P,
MAKBTN: SKIPG @(P)
JRST MAKBN2
MOVSI T,-4
MOVE TT,FABITS+1(T)
XCT @(P)
AOBJN T,.-2
MAKBN2: HRRZ T,1(G)
MOVEI TT,
ROTC T,-5
ROT TT,5
SETCM TT,BITTAB(TT)
AND TT,FABITS+1(T)
JRST MAKBTX
MAKBTB: PUSH P,G
HRRZ G,1(G)
ADD G,[1(T)]
MAKBB3: MOVSI T,-4
MOVE TT,@G
XCT @-1(P)
AOBJN T,.-2
POP P,G
JRST POPJ1
BITTAB: FOR I←43,0,-1{1⊗I↔}
;MAKBNB, MAKBBT, MAKBB2, MBDSP, MBIND, MBIND2
MAKBNB: PUSH P,G
HRRZ G,1(G)
ADD G,[1(T)]
MOVSI T,-4
SETCM TT,@G
AND TT,FABITS+1(T)
XCT @-1(P)
AOBJN T,.-3
POP P,G
JRST POPJ1
MAKBBT: FOR I←0,3{SETZM MBBUF+I↔}
PUSH P,H
MOVE H,G
HRRZ G,(G)
MAKBB2: PUSHJ P,MAKBT0
IORM TT,MBBUF(T)
HLRZ G,(G)
CAIE G,(H)
JRST MAKBB2
EXCH H,(P)
MOVE G,[,MBBUF(T)]
JRST MAKBB3
MBDSP: MOVEI TT,
JRST MAKBTB
JRST MAKBTN
JRST MAKBNB
JRST POPJ1
JRST MBIND
JSP SBARF
JSP SBARF
MBIND: PUSH P,G
HRRZ G,1(G)
MOVSI T,(<XCT @>)
HRRI T,-1(P)
PUSH P,T
HRRI T,(P)
PUSH P,[JRST MBIND2]
PUSH P,T
JRST MAKBT0
MBIND2: SUB P,[2,,2]
POP P,G
JRST POPJ1
;SCGEN
SCGEN: HRRZ C,VBBITS
JUMPE C,.+2
PUSHJ P,SBTMAK
SKIPE B,SSVMAX
PUSHJ P,SFSGET
SUBI A,1
HRRM A,SSVINS
MOVEI B,440
PUSHJ P,SFSGET
HRLI A,(<XCT (C)>)
MOVEM A,SCXCT#
MOVE T,SRCNT
MOVEM T,SRCN1#
PUSHJ P,ENDSET
MOVEI T,1(A)
MOVEM T,SCODPT#
MOVSI T,(<JSP D,>)
HLLM T,SBKINS
MOVE B,SGPNT
TRNN F,SDELIM
TDZA E,E
MOVNI E,1
PUSHJ P,SCGEN1
MOVSI T,LOKBIT
MOVEI A,2(A)
FSFIX A,T
SUBI A,1
EXCH A,SFSLST
HRLM A,@SFSLST
JRST ENDFIX
;SCGEN1, SCGEN2, SCGEN3, SCGEN4, SCGEN5, SCGEN6
SCGEN1: MOVEI C,
SCGEN2: SKIPGE 1(B)
JSP SARRGH
HLRZ D,(B)
MOVEI T,1(A)
HRLM T,(B)
LEG PUSH A,D
TRNN F,SBKWDS
JRST SCGEN3
LEG PUSH A,[LSHC B,-7]
LEG PUSH A,[ROT C,7]
SCGEN3: LDB G,[330400,,1(B)]
CAIL G,4
JSP SARRGH
HRRZ H,1(B)
JUMPE H,SCGFA
LDB T,[330400,,1(D)]
CAIL T,4
ADDI G,4
PUSHJ P,SCGTST
HLL D,1(B)
CAIL G,4
AOBJP A,SCGEN5
PUSHJ P,SCGBK1
CAIN G,2
JRST SCGNC
SCGEN4: LDB T,[221100,,1(B)]
JUMPE T,.+3
ADD T,SSVINS
LEG PUSH A,T
MOVE T,1(B)
TLNE T,SGEBIT
JRST SCGE
HLL C,(B)
EXCH C,(B)
EXCH C,B
MOVSI T,1000
HLLM T,SBKINS
AOJA E,SCGEN2
SCGEN5: PUSH P,A
PUSHJ P,SCGHB
MOVEI T,(A)
ADD T,SBKINS
POP P,TT
MOVEM T,(TT)
JRST SCGEN4
;SCGTST, SCGT2, SCGT3, SCGDSP, SCGCN, SCGCN2, SCGBTN, SCGBT
SCGTST: XCT SCGDSP(G)
TDNN T,SLMODE
JRST SCGT2
HRLI H,(<CAIN C,>)
LEG PUSH A,H
MOVSI T,(<JRST>)
HRRI T,3+1(A)
LEG PUSH A,T
TDCA H,[<CAIE>≠<CAIN 40>]
SCGT2: HRLI H,(<CAIE C,>)
SCGT3:
LEG PUSH A,H
POPJ P,
SCGDSP: MOVE T,CTAB(H)
JRST SCGBT
JRST SCGCN
JRST SCGBTN
JRST SCGCN
JRST SCGBTN
MOVE T,CTAB(H)
JRST SCGBT
SCGCN: MOVE T,CTAB(H)
TDNN T,SLMODE
JRST SCGCN2
HRLI H,(<CAIE C,>)
LEG PUSH A,H
TDCA H,[<CAIE>≠<CAIN 40>]
SCGCN2: HRLI H,(<CAIN C,>)
JRST SCGT3
SCGBTN: SKIPA T,[TDNE (C)]
SCGBT: MOVSI T,(<TDNN (C)>)
MOVS TT,5(H)
HLR T,TT
TRZE TT,400000
TLC T,(<TDNN>≠<TDNE>)
CAMG TT,[CTAB,,-1]
TRNE G,2
TDZA H,H
MOVSI H,NSPEC
IOR H,BEG(TT)
TRNN H,-1
TROA H,(<MOVSI>)
TLOA H,(<MOVEI>)
MOVS H,H
LEG PUSH A,H
LEG PUSH A,T
POPJ P,
;SCGE, SCGE2, SCGEL, SCGBAK, SCGBK1, SCGBK2, SCGBK3, SCGFA, SCGNC, SCGNFA
SCGE: MOVSI T,(<MOVEI>)
HRRI T,(E)
LEG PUSH A,T
LEG PUSH A,[SOSG SRCN1]
LEG PUSH A,[JSP D,SRCHX]
HRRZ D,(B)
LDB G,[330400,,1(D)]
PUSHJ P,SCGBAK
SCGE2: MOVE D,SCXCT
HLRZ G,(B)
MOVE T,(G)
HRLM T,(B)
MOVEM D,(G)
JUMPE C,CPOPJ
SCGEL: EXCH C,B
HLRZ G,(B)
HRL C,(G)
MOVEM D,(G)
EXCH C,(B)
TRNE C,-1
JRST SCGEL
POPJ P,
SCGBAK: CAIL G,4
JRST SCGHB
SCGBK1: HLRZ T,(D)
ADD T,SBKINS
SCGBK2: TLNN D,NLDBIT
SOJA T,.+3
SCGBK3: TRNE F,SBKWDS
ADDI T,2
LEG PUSH A,T
POPJ P,
SCGFA: CAIGE G,2
JRST SCGNFA
SCGNC: MOVSI T,37740
HRRI T,2(A)
LEG PUSH A,T
JRST SCGEN4
SCGNFA:
LEG PUSH A,[JRST SRCHLX]
JRST SCGE2
;SCGHB, SCGHB0, SCGHB5, SCGHB1, SCGHB2, SCGHB3, SCGHB4, SCGHBX, SCGHX2
SCGHB: MOVEI T,(A)
LEG PUSH A,[MOVEM C,SBTST]
SCGHB0: HRLM T,(P)
LDB G,[330400,,1(D)]
CAIE G,XFRSAV
JRST SCGCB
SCGHB5: SUBI T,-774(A)
ROT T,-15
HRRI T,1+2(A)
LEG PUSH A,[MOVE C,SBTST]
LEG PUSH A,T
SCGHB1: HRRZ H,1(D)
LDB T,[221100,,1(H)]
JUMPN T,SCGHB3
MOVSI T,(<MOVEI C,>)
HRR T,1(H)
SCGHB2:
LEG PUSH A,T
LDB T,[221100,,1(D)]
ADD T,SSVINS
LEG PUSH A,T
HLL D,1(D)
HRR D,(D)
LDB G,[330400,,1(D)]
CAIGE G,4
JRST SCGHBX
CAIE G,XFRSAV
JSP SARRGH
JRST SCGHB1
SCGHB3: HRLI T,(<MOVE C,>)
ADDI T,@SSVINS
JRST SCGHB2
SCGHB4: CAIL G,4
JRST SCGHB5
SCGHBX: HLRZ T,(P)
SCGHX2: SUBI T,-774(A)
ROT T,-15
HLR T,(D)
LEG PUSH A,[MOVE C,SBTST]
AOJA T,SCGBK2
;SCGCB, SCGCB0, SCGCB1, SCGCB2, SCGCB3, SCGCB4, SCGCB5, SCGHCB
SCGCB: PUSH P,C
SCGCB0: MOVEI C,
SCGCB1: HRRZ H,1(D)
JUMPE H,[HLL D,1(D)↔HLR D,(D)↔JRST SCGCB3]
LDB T,[221100,,1(D)]
HRLI T,(<MOVE C,>)
ADDI T,@SSVINS
LEG PUSH A,T
TRZE G,REMTST
JRST SCGCB2
CAIE G,INDTST
JSP SARRGH
LDB G,[330400,,1(H)]
HRRZ H,1(H)
SCGCB2: CAIL G,4
JSP SARRGH
PUSHJ P,SCGTST
LEG PUSH A,C
MOVEI C,(A)
SCGCNO: HLRZ T,(D)
HLL T,1(D)
HRRZ D,(D)
SCGCB3: LDB G,[330400,,1(D)]
CAIL G,INDTST
JRST SCGCB1
PUSH P,T
CAIL G,4
JRST SCGHCB
HLRZ T,-2(P)
PUSHJ P,SCGHX2
SCGCB4: MOVSI H,(<JRST>)
TROA H,1(A)
SCGCB5: MOVEI C,(T)
MOVE T,(C)
MOVEM H,(C)
JUMPN T,SCGCB5
POP P,D
LDB G,[330400,,1(D)]
CAIL G,INDTST
JRST SCGCB0
POP P,C
HLRZ T,(P)
JRST SCGHB4
SCGHCB: HLRZ T,-2(P)
PUSHJ P,SCGHB0
JRST SCGCB4
;SBTMAK, SBTMK1, SBTMK2, SBTMK3, SBTMK4, SCGENB, SCGHB, SSVINS, SCXCT, SBKNW, SBKNWA, SBKDSP
SBTMAK: MOVEI B,200
PUSHJ P,SFSGET
MOVSI T,(A)
HRRI T,1(A)
SETZM (A)
BLT T,177(A)
MOVEI B,43
SBTMK1: HRLI A,BITTAB-BEG(B)
MOVEM A,5(C)
MOVE D,BITTAB(B)
HRLI C,-4
MOVSI G,TT
HRRI G,(A)
SBTMK2: SKIPE T,1(C)
JFFO T,SBTMK4
SBTMK3: ADDI G,40
AOBJN C,SBTMK2
HRRZ C,-4(C)
JUMPE C,CPOPJ
SOJGE B,SBTMK1
JRST SBTMAK
SBTMK4: IORM D,@G
ANDCM T,BITTAB(TT)
JFFO T,SBTMK4
JRST SBTMK3
IMPURE
SSVINS: MOVEM C,...
SBKINS: JSP D,1
SBKNW: SOJL A,...
SBKNWA: MOVE B,...(A)
SBKNWR: LSH B,-1
SBKNWX: JSP @
SBKDSP: REPEAT 4,<ADDI 3↔ROT C,7↔JSP @>
SBKNLX←.-1
JSP SBKNW
PURE
;SRCPAG SRCPG1 SPFIN SPFL SPFL2 SPFX NOSRC2 SRCLBL SRCPG3
;Here to continue searching from last string found for LBLSRC
SRCLBL: MOVEI T,SRCHLX ;Routine to go to upon hitting end of search page
MOVEM T,SRCHLA
JRST SRCPG3
SRCPAG: MOVEI T,SRCHLX ;Entry from FINDIT (one page search)
SRCPG1: MOVEM T,SRCHLA# ;T has SCONTF not SRCHLX if from FIND (extended)
MOVE T,ARRLIN ;Start search from arrow line
MOVEM T,SRCLIN#
MOVE T,ARRL
MOVEM T,SRCL#
SRCPG3: MOVEI T,SBKNL
MOVE D,[SRCPGB,,SRCPGF]
PUSHJ P,SRCSET
MOVE A,SRCLIN ;Get FS pointer for line to start search from
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
CAME T,SRCNUM
SETOM SRCOFF# ;No search string found yet
TRNE F,SBKWDS
JRST NOSRC2
HRRE E,SRCOFF ;May be negative if searching from 1st char
TRNE F,SDELIM
SUBI E,1
PUSHJ P,GBYTP
SKIPA C,[15]
ILDB C,A
MOVEI D,3
PUSHJ P,SCALL
POPJ P,
AOS (P) ;Success--skip return
MOVEM A,SAVEBP# ;Save byte pointer to end of string for LBLSRC
JRST SCNBAK
;This routine backs up from the beginning of the found string to the beginning
;of the line (actually to the end of the prev line) to figure out SRCOFF.
SPFIN: MOVEI T,SPFX
MOVEM T,SRCHLA
SPFL: XCT SCXCT
LSHC B,-7
ROT C,7
CAIE C,15 ;Have we gotten into prev line yet?
AOJA E,SPFL ;No, continue counting
MOVE G ;Yes
SPFL2: HRRZ T,@SRCLIN
MOVEM T,SRCLIN
AOS SRCL
SKIPGE TXTFLG(T) ;Another ALS missed--was 1(T)
JRST SPFL2 ;Skip over this pagemark
SPFX: HRRZM E,SRCOFF#
MOVE T,SRCLIN
HRRZ T,TXTSER(T) ;Was HRRZ T,2(T)
MOVEM T,SRCNUM#
POPJ P,
NOSRC2: SORRY REVERSE SEARCHES NOT IMPLEMENTED.
JRST SBARF2
;GBYTP, GBYTPL, GBTPX, GBPDSP, GBPTAB
GBYTP: CAIE A,BOTSTR
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A)
POPJ P,
HRRZ T,TXTCNT(A) ;Needed when TXTCNT≠TXTFLG
ADD A,[10700,,LLDESC-1]
SKIPN T
ADD A,[340000,,1]
JUMPE E,POPJ1
JUMPL E,GBPNEG
MOVSI T,LSPC
MOVEI DSP,GBPDSP-2
GBYTPL: GETCH2 T,A
GBPTX: SOJG E,GBYTPL
JRST POPJ1
GBPNEG: MOVEI C,40
JRST POPJ2
GBPDSP: POPJ P,
PUSHJ P,TELL3
JRST GBPTAB
PUSHJ P,TELL5
GBPTAB: ILDB C,A
CAIE C,11
JRST GBPTAB
JRST GBPTX
BTAB3: 10700,,-10
100700,,-17
170700,,-26
260700,,-35
350700,,
;SRCPGF, SPFTAB, SPFCR, SPFLUZ
SRCPGF: 15↔JSP SPFCR
11↔JSP SPFTAB
177↔JSP SARRGH
0↔JSP SARRGH
SPFTAB: ILDB C,A
CAIE C,11
JRST .-2
ILDB C,A
JRST @
SPFCR: HRRZ A,@SRCLIN
CAIN A,BOTSTR
JRST @SRCHLA
MOVEM A,SRCLIN
AOS SRCL
SKIPGE B,TXTFLG(A) ;Was SKIPGE B,1(A)
JRST SPFCR
HRRZ B,TXTCNT(A) ;Needed if TXTFLG≠TXTCNT
SKIPN B
TLOA A,350700
HRLI A,440700
ADDI A,LLDESC
ILDB C,A
JRST @
;SRCPGB, SPFTAB, SBKNL, SBKNUL
SRCPGB: 11↔JSP D,SPBTAB
0↔JSP SARRGH
SPBTAB: XCT @
LSHC B,-7
ROT C,7
CAIE C,11
JRST SPBTAB
MOVEI C,177
JRST -1(D)
SBKNL: HLRZ B,@SRCLIN
CAIN B,PAGE
JRST @SRCHLA
MOVEM B,SRCLIN
SOS SRCL
SKIPGE A,TXTFLG(B) ;Was SKIPGE A,1(B)
JRST SBKNL
HRRZ A,TXTCNT(B) ;Needed to split TXTFLG FROM TXTCNT
SKIPN A
JRST SBKNUL
MOVEI A,LLDESC(B)
HRRM A,SBKNWA
HRRZ A,-LLDESC-1(A)
SUBI A,LLDESC+2+1
XCT SBKNWA
LSH B,-1
LSHC B,-7
JUMPN C,[ROT C,7↔SOJA SBKNWX]
SUBI 1
FOR I←0,3<LSHC B,-7↔JUMPN C,SBKDSP+1+3*I
> JSP SARRGH
SBKNUL: MOVEI C,15
MOVEI A,
ADDI 2
JRST SBKNLX
;SRCSET, SRCST1, SRCSTL, SRCST2
SRCSET: HRRM T,SBKNW
MOVEM D,SRCTYP#
SRCST1: MOVE A,SCXCT
TRNE F,SBKWDS
SKIPA T,[XCT @]
SKIPA T,[ILDB C,A]
MOVS D,D
MOVEM T,1(A)
MOVSI T,1(A)
HRRI T,2(A)
BLT T,177(A)
MOVE T,[JRST @40]
MOVEM T,200(A)
MOVSI T,200(A)
HRRI T,201(A)
BLT T,377(A)
SRCSTL: MOVE C,(D)
CAIGE C,200
JRST SRCST2
MOVE T,[JSP D,SOOPS]
MOVEM T,@A
SUBI C,200
SRCST2: MOVE T,1(D)
MOVEM T,@A
ADDI D,2
JUMPN C,SRCSTL
POPJ P,
;SCALL, SRCHX, SRCHLX
SCALL: MOVE T,SCXCT
ADDI T,200
MOVEM T,41
MOVEM SBTST
HRRZ SCXCT
ADDI SSPACS+1
MOVEM 1,@
HRLI 2
AOS 1,
BLT 16(1)
MOVE SBTST
MOVEM -2(1)
MOVE 1,-1(1)
ADD D,SCODPT
JRST @SCODPT
SRCHX: HRRZ 17,SCXCT
MOVE 16,SSPACS+P(17)
AOSA (16)
SRCHLX: HRRZ 17,SCXCT
MOVEM SSPACS+E(17)
MOVE SSPACS(17)
MOVSI 17,SSPACS+D(17)
HRRI 17,D
+CM←9 84(&lzZ∃α"bnBV≤B)αAe*V>"hh(&6⎇2⊗5α"aQD4PJb∞Q¬~J∞∩β_$%n≡c↔πIπ≠↔πK≡AβCπ>)β;Wn∪↔IβN1β?9∧J&%8hR&&&≤→Mh&≤Z&B9∧*N∞%⊂H%n#∂3∃β←*β ↔↔rβ';S/∪KWC&+⊃|4PJB>BRαA0$HIn;<hP&BV≤B)αAd
∞Jd0$%n'KC∃α≥∩2→↓F≠3? ⊗+KMα"I84(LzVRN%⊃αnε≤~&i↓zα⊗N
∧IβS↔⊗k';π&K?9β∂!β↔;"β?→βε ∨∃↓⎇h4(&≤*Rj5¬"f>Bu 4(&%JB∩⊗~αNJ∞∧84(&U∩NQα∀*⊗BN H%n∪}q∨Qβ⊗+↔AβFK557F)β+W∨!β';&+KKWπ#↔⊃β/→84(1nN≤r
ε-bαN∞:∀Z04(hRN∞:∀
-h&¬*N!ααb∧4(MαVN!¬↓2⊂4PJ6>Z*α⊃2N∀~Rf@hP&RJ~α→2N∀Z↑∩LhP&BV≤B)αAe~J∞N#λ4(&∧zAαAd 4(&∧zAαAdλ4(&%∩∞9α2bN
.<"L4(LRNAα≤
JJ≡@h(&2$⊃α
2λh(&∞ J9α
c D4(Lj>Z⊗Jα
1Qh(&6⎇2∃α bB¬$4PJRJ:rα→2>42Bε≤hP&N.Mα¬αQe~J∞2Lp4(&≤Z&B¬¬!2n&∃*~t4PJε∩∩JαQ22d"⊗N hP&NV∀Iα¬1E!$4(LBJJ5¬!2N
\r↑∧4PJ2∩ ∧!2mM;↓MAAbbεt4PJε:∩Jα¬15λh(&6⎇2∃α⊃d∩Rε D!$4(LbN!α∩bα
R ⊃M"⊃Hh(&&m*2%α"aL4(Lj>Z∃∧904(Lj>Z⊗JαN
.%~A"⊃Hh(&6⎇2⊗%α"bN∞:∀Z1-ThP&6>4)αQ2≤~b∞PhP&6>4*5αQe~∞:
\`4(&lzZN%∧A2:N∧*
ε2≥α 4(Lj>Z⊗Jα∩NAe~∞
∩≥4(&U*6B9∧)2N∞t∩.04PJB>BRαA04TJ6BV∀(4*N≤r
.1PJb∞Qαq99"~H4(&e~"
α∩a5\4PJJ>Q∧→1\4PJR∩:*α!2∞$
"
Hh(&b≥!αα∞$
"
Hh(&N|R≥α∃e~∞:
\`4(&∧zB)αα`4*B-∩∀4(hRN∞
%~Ah&U∩NQα≤~:
.`h(&*≥↓αNε∃∩≡ 4PJ*~∞`h(&*∃~QαN≤r
.0hP&*~≤`4(&U∩NQα≤~:
.`h(&*4~04(1nN≤z:R→¬~J∞~u↓αNJ≤2: α≤2: I¬~~J⊗%⊃αNJ≤"Beα≥∩∞∩A∩αNJ∞5αAαN∀~∩AM∧r>NJ≥↓αNJ≤B⊗⊃1¬~J∞∩ h(4*≤~>:R3P&6>4)α⊃0hP&ε∩$Iα⊃1⊂h(&*≥↓α¬2≤:Rε∞_h(&B-~!αAe 4(&¬*N!ααb⊂4(Lj>Z⊗JαQ2N∀Z:λ4PJ6>Z*α⊃2n≥∩∞~ bbNJ∞42t4(MαVN"RαA2N∀~N⊗PhP&B>ααA2⊂hP&B>ααA2PhP&RJzα→2>42~P0PAG
MOVE A,DIRPT
MOVEM A,SDIRPT#
MOVE A,CURPAG
MOVEM A,SRCPG#
JSP A,SRTACS
SRCFNP: HRRZ A,@SDIRPT
CAIN A,DIREND
JRST SRCHLX
SKIPN ESCIEN ;Has user typed ESC I? (Only place ESCIEN is tested)
JRST SRCFP2 ;Nope, go on.
SETOM ESCI2 ;We have now been interrupted by ESC I
JRST SRCHLX
IMPURE
SRCHED: 600000,,SRCDD
SRCDDL
0
SRCDD+1
SRCDD: CW 1,46,2,0,1,46
CW 3,=74,4,1,5,10
ASCID/Page /
SRCPGD: ASCID/000
/
0
SRCDDL←←.-SRCDD
SRCDPY: 0
JRST NOSRCP ;TTY
SKIPE SRCHED+2 ;DD
JRST SRCIII ;III
SRCDP3: 0
JFCL ;TTY
JFCL ;DD
PGACT 677777 ;III. Turn off search page number.
PURE
SRCDP2: CW 3,=74,4,1,5,10 ;DD. position for search page number
BYTE (11)530,710 (3)5,3 (2)1,2 (4)6 ;III
; XPOS,YPOS/BRT,SIZE
SRCFP2: PUSHJ P,SRCFPP ;To display page number during search
JRST SRCFP3
;Used in SRCFP2 above and by PARFF2 AND PAREXT in the PAREN search code
SRCFPP: MOVEM A,SDIRPT
AOS A,SRCPG ;Now searching next page
MOVEM B,BSAV# ;Who knows what evil lurks in the hearts of B!
XCT SRCDPY ;Depends on terminal type
JRST NOSRCP ;Last transfer still in progress--forget this one
MOVE B,SCRTOP
HLLZS DPYTAB(B) ;Force redisplay of top line
SRCIII: IDIVI A,=10
DPB B,[POINT 4,SRCPGD,20] ;Units place digit
IDIVI A,=10
DPB B,[POINT 4,SRCPGD,13] ;Tens place digit
DPB A,[POINT 4,SRCPGD,6] ;Hundreds place digit
DPYOUT 2,SRCHED
NOSRCP: MOVE B,BSAV ;Restore
MOVE A,SDIRPT ;Restore
POPJ P,
SRCFP3: SKIPN A,1(A)
JRST SIOERR
MOVEI C,-1(A)
CAME C,IBLK
XCT %SETI
MOVEM C,IBLK
ANDCMI A,-1
ROT A,7
ADD A,IBFPNT
IBP A
JRST SFNB2
SRCFNB: HRRZ A,@SDIRPT
HRRZ A,1(A)
SUBI A,1
CAMG A,IBLK
JRST SRCFNP
MOVE A,IBFPNT
SFNB2:
XCT %IN
SIOCH3: AOSA IBLK
JRST SIOCHK ;See why IN lost
SFRETR: HLRZ C,-3(D)
CAIE C,(<XCT (C)>)
SOJA D,SFRETR
MOVEI C,40
JRST -3(D)
SIOCHK: MOVEM C,SAVEC# ;Get an AC
XCT %STAT
TRNN C,20000 ;EOF?
JRST SIOCH2 ;No, lose
MOVE C,IBLK
LSH C,7 ;Number of words successfully read
CAML C,FILWC ;Beyond EOF already?
JRST SIOCH2 ;Lose
SUB C,FILWC ;Negative of number of real words in last buffer
MOVN C,C
SETZM IBUF(C) ;Fill rest of buffer with nulls
MOVEI C,IBUF+1(C)
HRLI C,-1(C) ;pointer to BLT rest of buffer with nulls
CAME C,[IBUF+177,,IBUF+200] ;Don't do BLT if only one word left
BLT C,IBUF+177
MOVE C,SAVEC ;Restore C
JRST SIOCH3
SIOCH2: MOVE C,SAVEC
JRST SIOERR ;Lose after all
;SRCFF, SFFNUL, SGTACS, SRTACS
SRCFF: 377↔JRST SRCFNB
212↔JRST SFRETR
200↔JRST SFFNUL
SFFNUL: SKIPE (A)
JRST SFRETR
SKIPN 1(A)
AOJA A,.-1
HRLI A,700
JRST SFRETR
SSPACS←←400
SSSACS←←420
SGTACS: EXCH A,SCXCT
MOVE F,SSPACS+F(A)
MOVEM P,SSSACS+P(A)
MOVE P,SSPACS+P(A)
EXCH A,SCXCT
JRST (A)
SRTACS: EXCH A,SCXCT
MOVEM F,SSPACS+F(A)
MOVE P,SSSACS+P(A)
EXCH A,SCXCT
JRST (A)
SOOPS: HLL D,40
TLNN D,¬1000
XCT SCXCT
LSH C,22-15
HLL C,D
ROT C,15
ADDI D,-774(C)
HLRZ C,C
XCT SCXCT
;SRCFB, SFBNUL, SBKNB, SBKNB2, SIOERR, SBKNP
SRCFB: 14↔JRST SFBNUL
12↔JRST SFBNUL
0↔JRST SFBNUL
SFBNUL: HLRZ C,-5(D)
CAIE C,(<XCT (C)>)
SOJA D,SFBNUL
MOVEI C,177
JUMPN B,-5(D)
MOVEI -5(D)
SOJL A,SBKNB
SKIPN B,@SBKNWA
SOJGE A,.-1
JUMPGE A,SBKNWR
SBKNB: MOVE A,SDIRPT
HRRZ A,1(A)
CAML A,IBLK
JRST SBKNP
SBKNB2: SOS A,IBLK
XCT %SETI
MOVEI A,177
XCT %IN
JRST SBKNWA
SIOERR: OUTSTR [ASCIZ \SEARCH I/O ERROR.
\]
JRST SRCHLX
SBKNP: JSP SBARF
;JCTAB PINXLT PARGET NEXTLI
COMMENT ⊗
Register assignments used in main section of JUST (and related routines)
A Input character pointer
B Input line address
C Current character
D Output character pointer
E Address of table defining data region
F Usual flag word
G Character count for output line (-x,,0 at start)
H Special flag word
I Address of line into which characters are going
J Input char count for TJ commands
K Output tab field termination position for TJ commands
DSP Current dispatch table address
P Stack pointer, as usual
Q Several counting jobs and to index TABOLD and TABTAB
T Temporary
TT Temporary
Special flag usage with F during JUST etc. (after initial normal usage)
Right half of F
NEG set to 0 for JUST, to 1 for JFILL
REL set to 0 for no par. break, to 1 for par. break
Left half of F
TF1 used in JPREAD to keep neg sign info and then
set to 0 foe first pass, to 1 for second pass in JUST
TF2 set to 0 for JUST and JFILL, to 1 for TJUST and TFILL
TF3 set to 1 for JSTOP and JJSTOP commands
End of comment ⊗
;Special flags tested against H (for use with JUST and related commands)
JUSF←←200000 ;CR, LF, VT, FF, SP, TAB, . ! ?
; LSPC←←100000 ;Special character, previously defined
; NUMF←←40000 ;Number " "
JALL←←20000 ;Dispatch on all characters
; LETF←←10000 ;Letter (with LT2F => lower case)
; LT2F←←4000 ;Alone=> $ % . _
JTBF←←2000 ;TAB
JCRF←←1000 ;CR, LF, FF, VT
;Dispatch displacements used in following table
; 0 CR, LF, NUL and all disallowed chars. for in-core pages
; 1 TAB (11)
; 2 Space (40)
; 3 Sentence terminating punctuation . ? !
; 4 Closures ) ] > } "
; 5 All other normal characters
;Special character-dispatch table for use with JUST and related commands
JCTAB: JALL!JUSF,,(DSP) ;NUL 0
REPEAT 10<JALL,,5(DSP)> ;↓ α β ∧ ¬ ε π λ 1,2,3,4,5,6,7,10
JALL!JUSF!JTBF!LSPC,,1(DSP) ;TAB 11
REPEAT 3,<JALL!JUSF!JCRF!LSPC,,(DSP)> ;LF,VT,FF 12,13,14
JALL!JUSF!JCRF!LSPC,,(DSP) ;CR 15
JALL,,5(DSP) ;∞ 16
JALL,,5(DSP) ;∂ 17
REPEAT 20,<JALL,,5(DSP)> ; ⊂ ⊃ ∩ ∪ ∀ ∃ ⊗ ↔ _ → ~ ≠ ≤ ≥ ≡ ∨ 20 thru 37
JALL!JUSF,,2(DSP) ;SP 40
JALL!JUSF,,3(DSP) ;! 41
JALL,,4(DSP) ;" 42
REPEAT 5,<JALL,,5(DSP)> ;# % & ' 43,44,45,46,47
JALL,,5(DSP) ;( 50
JALL,,4(DSP) ;) 51
REPEAT 4,<JALL,,5(DSP)> ;* + , - 52,53,54,55
JALL!JUSF,,3(DSP) ;. 56
JALL,,5(DSP) ;/ 57
REPEAT 12,<JALL!NUMF,,5(DSP)> ;0,1,2,3,4,5,6,7,8,9 60 thru 71
REPEAT 2,<JALL,,5(DSP)> ; : ; 72,73
REPEAT 2,<JALL,,5(DSP)> ; < = 74,75
JALL,,4(DSP) ; > 76
JALL!JUSF,,3(DSP) ;? 77
JALL,,5(DSP) ;@ 100
REPEAT 32,<JALL!LETF,,5(DSP)> ;A to Z 101 thru 132
REPEAT 2,<JALL,,5(DSP)> ;[ \ 133,134
JALL,,4(DSP) ;] 135
REPEAT 3,<JALL,,5(DSP)> ;↑ ← ` 136,137,140
REPEAT 32,<JALL!LETF!LT2F,,5(DSP)> ;a th z 141 thru 172
JALL,,5(DSP) ;{ 173
JALL,,5(DSP) ;| 174
JALL!JUSF!LSPC,,(DSP) ;ALT 175
JALL,,4(DSP) ;} 176
JALL!JUSF!NSPEC,,(DSP) ;RUBOUT 177
MINTXT←←3 ;Minimum allowed text length or TAB field
TJSCNT←←2 ;Minimum number of spaces to terminate a TAB field
TABCNT←←40 ;Allow 32 tabs
JPT1←←0
JPT2←←1
JETST←←2
JLPTR←←3
JCPTR←←4
JEXIT←←5
JPTAB: ARRLIN
,PAGE ;STUPID FAIL
BOTSTR
LINES
CHARS
PUSHJ P,LINSET
JRST SETWRT
JATAB: ATTBUF
ATTBUF
ATTBUF
ATTNUM
ATTSIZ
MOVE T,ATTNUM
CAILE T,ATTMAX
MOVEI T,ATTMAX
PUSHJ P,EXSET
JRST ATTWRT
; Locations to hold Margin specifications
IMPURE
TMPMAR: 1 ;Temporary margin for one line only.
PMAR: 4 ;Paragraph margin indent
LMAR: 0 ;Left justifying margin indent
RMAR: =69 ;Right justifying margin.
BNUM: 1 ;Number of blank lines between paragraphs
PMARO: 4
LMARO: 0
RMARO: =72
BNUMO: 1
JPMAR: 4
JLMAR: 0
JRMAR: 69
JBNUM: 1
TPMAR: 4
TLMAR: 0
TRMAR: 69
TBNUM: 1
TABOLD: BLOCK TABCNT ;Old tabulations
-1 ;Guard cell
TABTAB: BLOCK TABCNT ;New tabulations
-1 ;Guard cell
JPMARO: 0
JLMARO: 0
JRMARO: 1
JBNUMO: 1
TPMARO: 0
TLMARO: 0
TRMARO: 0
TBNOMO: 1
DTBCNT: 0
DSPCNT: 0
INMAR: 4
AMAR: 0
RJMARS: =80 ;Sticky JOIN right margin allows room for some editing.
BREAKV: =80 ;Break value (always sticky)
;Memory locations to hold other variables
JCNT: 0 ;Count of lines to be processed
JCNTC: 0 ;Current value of JCNT during first pass
JPTR: 0 ;Location of first line of text being processed
JPTRC: 0 ;Location of first line of group currently being handled
JRPT: 0 ;Next line after text being processed
JWCOL: 0 ;Char count at last word break
JSCNT: 0 ;Word break count
JBUGR: 0 ;Bugger factor to distribute extra spaces
JWPT: 0 ;Accumulated count of extra spaces added
JSINC: 0 ;Needed spaces times 8
JSIZE: 0 ;JSINC times number of breaks already processed
JMARG: 0 ;Current output line's left margin
PARFLG: 0 ;Set for new par. conditions as defined by PMARO, LMARO and BNUMO
; Value assigned to PARFLG
; 0 means blank line needed to signal new par.
; -1 means new par. every new line
; +1 means new par if indent is >1
; X>1 means new par. if indent is =X
PURE
;J1DSP J2DSP J3DSP J4DSP J5DSP J6DSP J7DSP
; Action on reaching a CR in the input text
J2CR: TLNN F,TF1 ;Is this the first pass
JRST J2CR2 ;Yes
; CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
; MOVEM I,ARRLIS ;Yes, so change pointer
PUSHJ P,NEXTLI ;Finish off line and get next
SOSG JCNT
JRST J2CR5 ;We should never get here, but just in case
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so change pointer
J2CR1: MOVEI C,40 ;Replace CR with a space and cont.
SOS (P) ;To interpret the CR
POPJ P,
; First pass treatment
J2CR2: SOSLE JCNTC
JRST J2CR3
TRO F,ARG ;Set end of text signal for second pass
JRST J2CR4 ;Treat end of text as end of par. here
J2CR3: PUSHJ P,PARGET ;To get correct par info.
TRNN F,REL
JRST J2CR1 ;No new par. so replace CR with space and continue
J2CR4: TRO F,REL ;May enter here if end of data
CAIN DSP,J1DSP ;Save data only after a non-space last char.
JRST J2CR5
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count at this word break
J2CR5: AOS (P) ;Forces an exit from loop without incrementing G
POPJ P,
; To eat all extra spaces and tabs
J1SP: MOVNI C,3
ADDM C,(P) ;This backs up to the ILDB command
POPJ P,
; Action at end of a word signalled by a space or tab
J2TAB: MOVEI C,40
J2SP: MOVEI DSP,J1DSP
MOVSI H,JALL
TLNE F,TF2 ;Is this a TJ situation?
JRST J2SP3 ;Yes
J2SP1: TLNE F,TF1 ;Test for pass
JRST J2SP2 ;Second pass
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count to this word break
POPJ P,
; Second pass
J2SP2: TRNN F,NEG!REL ;Is this line to be justified?
JUSPAD: SKIPN T,JSINC ;8 times the needed number of extra spaces
POPJ P, ;Exit if no extra spaces are required
; To introduce extra spaces as required to justify
ADDB T,JSIZE
IDIV T,JSCNT ;Divide by available-location count
ADD T,JBUGR ;Current bugger factor to distribute extra spaces
LSH T,-3 ;Divide by 8
SUB T,JWPT ;JWPT counts additions to date
ADDM T,JWPT
JUMPE T,JUSPA2
JUSPA1:
LEG IDPB C,D ;Add an extra space
AOBJP G,JUSPA2 ;Should always be negative
SOJG T,JUSPA1
JUSPA2: POPJ P,
; Special treatment for TJUST and TJFILL case
J2SP3: SKIPG TT,TABTAB(Q) ;Is there another Tab field?
JRST J2SP1 ;No
MOVE T,A
ILDB C,T ;Sneak a look at the next character
CAIE C,40
CAIN C,11
SKIPA
POPJ P, ;Treat a single space as any normal character
AOS Q ;Get ready for the next field
HRRZ T,TT ;Get the last location of this field
SUB T,TPMAR ;Relative to start of text
TLNN F,TF1
JRST J2SP4
LEG IDPB C,A
LEG IDPB C,A ;Put in at least 2 spaces
SKIPA
J2SP4: HRRZM G,JWCOL ;Safety precaution in case this field ends line
AOBJP G,J2SP7
AOBJP G,J2SP7 ;Can only exit if on first pass
SUBI T,(G) ;Can we add more spaces?
JUMPGE T,J2SP6
J2SP5: TLNE F,TF1
LEG IDPB C,A
AOBJP G,J2SP7
AOJL T,J2SP5
J2SP6: POPJ P,
J2SP7: AOS JSCNT ;To treat line as a single word
AOS (P) ;Exit from loop
POPJ P,
; Action on receipt of a sentence-terminating type punctuation mark
J2PUN: MOVEI DSP,J3DSP
MOVSI H,JALL
POPJ P,
; Action at end of sentence signalled by punctuation and space or tab
; or by punctuation then a closure then a space or tab
J3TAB: MOVEI C,40
J3SP: MOVEI DSP,J1DSP
TLNE F,TF2 ;Is this a TJ situation?
JRST J2SP3 ;Treat like any space if in a Tab field
TLNE F,TF1
JRST J3SP2 ;Its on the second pass
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count at this word break
TLNE F,TF3
JRST J3SP3 ;Woops! make this a par break
AOBJN G,J3SP1 ;Count for an extra space if possible
SUB G,[1,,1]
J3SP1: POPJ P,
J3SP2:
LEG IDPB C,D ;Introduce second space always
AOBJN G,J2SP2 ;(should always be OK)
POPJ P, ;Safety exit
J3SP3: TRO F,REL ;Signal end of par
AOS (P) ;Force exit from loop
POPJ P,
; Action on normal character if using JIDSP or J3DSP
J1CH: MOVEI DSP,J2DSP
MOVSI H,JUSF
POPJ P,
;Special dispatch tables used with JCTAB (Table address in DSP)
; and using the above routines
; After a space with JALL flag used
J1DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J1SP ;TAB (eaten)
PUSHJ P,J1SP ;Space (eaten)
PUSHJ P,J1CH ;Punctuation (MOVEI DSP,J2DSP↔MOVSI H,JUSF)
PUSHJ P,J1CH ;Closure " "
PUSHJ P,J1CH ;Other character " "
; After a normal char. with JUSF flag used
J2DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J2TAB ;TAB (MOVEI DSP,J1DSP↔MOVSI H,JALL)
PUSHJ P,J2SP ;Space " "
PUSHJ P,J2PUN ;Punctuation (MOVEI DSP,J3DSP↔MOVSI H,JALL)
JFCL ;(Never used)
JFCL ;(Never used)
; After sentence-terminating punctuation with JALL flag used
J3DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J3TAB ;TAB (Replaced by space and handled as such)
PUSHJ P,J3SP ;Space (Introduces extra space and MOVEI DSP,J1DSP)
JFCL ;Punctuation
JFCL ;Closure
PUSHJ P,J1CH ;Other character (MOVEI DSP,J2DSP↔MOVSI H,JUSF)
; CENTER, INDENT, ALIGN, etc. routines and dispatch tables
; On finding a leading space
J4SP: AOJA T,J1SP ;Count then eat
; On finding the first non-space and non-tab
J4CH: CAILE Q,5
MOVEI Q,5
JRST @J4CHD(Q)
J4CHD: J4CH0 ;Go to appropiate code as determined by Q
J4CH1
J4CH2
J4CH3
J4CH4
J4CHX
; Set desired margin
J4CHX: MOVEI DSP,J5DSP
MOVSI H,JTBF!JCRF
PUSH P,C
PUSHJ P,JMSTRT ;Start line with appropiate margin
POP P,C
POPJ P,
; Get margin for INDENT
J4CH0: ADD T,INMAR
SKIPGE T
SETZ T,
JRST J4CHX
; Get margin for CENTER
J4CH1: SUB T,JWCOL ;Neg.of the number of text char. less initial spaces
ADD T,JSIZE
SKIPGE T
SETZ T,
LSH T,-1 ;Divide by 2
ADD T,LMAR
JRST J4CHX
; Get margin for ALIGN
J4CH2: MOVE T,AMAR
JRST J4CHX
; Get margin for RTARR
J4CH3: MOVE TT,INMAR
SKIPG TT
J4CH3A: MOVNS TT
J4CH3B: ADD T,TT
JUMPGE T,J4CHX
SETZ T,
JRST J4CHX
; Get margin for LFARR
J4CH4: MOVE TT,INMAR
JUMPG TT,J4CH3A
JRST J4CH3B
; On finding a CR before any other non-space characters
J4CR: MOVEI C,40
LEG IDPB C,D
AOS G
; On finding a CR after some text
J5CR: MOVEI DSP,J4DSP
MOVSI H,JALL
AOS (P) ;To skip the IDPB
AOS (P) ;To exit from loop
POPJ P,
; On finding an interior TAB
J5TAB: SKIPN JBUGR
JRST J1SP ;Eat it in this case
LEG IDPB C,D ;Write out first TAB when found
MOVSI T,1 ;TAB counts 1 in left of TXTCNT
ADDM T,TXTCNT(I)
HRRZ T,TXTCNT(I) ;Columns already accounted for
HRRZ TT,G ;Column count accumulating in G
ADD T,TT ;The actual column position
ANDI T,7 ;modulo 8
MOVEI TT,10
SUB TT,T
ADDM TT,TXTCNT(I)
MOVEI T,40
J5TAB2:
LEG IDPB T,D
SOJG TT,J5TAB2
LEG IDPB C,D ;Closing TAB
J5TAB3: ILDB C,A
CAIN C,40
JRST J5TAB3 ;Eat the spaces
CAIN C,11 ;Look for the closing TAB
JRST J1SP ;Eat it and go on
SOS (P)
SOS (P) ;Take a look at this character!
POPJ P, ;Should never get here, but just in case
; Initial dispatch table to eat spaces and tabs
J4DSP: PUSHJ P,J4CR ;CR (An all space line, maybe it is wanted)
PUSHJ P,J1SP ;TAB (eaten)
PUSHJ P,J4SP ;Space (counted then eaten)
PUSHJ P,J4CH ;Punctuation (MOVEI DSP,J5DSP↔MOVSI H,JTBF)
PUSHJ P,J4CH ;Closure " "
PUSHJ P,J4CH ;Other character " "
; In-text dispatch table to look for a TAB or a CR
J5DSP: PUSHJ P,J5CR ;CR
PUSHJ P,J5TAB ;TAB (special treatment depending on JBUGR setting)
JFCL
JFCL
JFCL
JFCL
;PARGET NEXTLI ADJARG JNEW JMORE
; Subroutine to get new par. indicator
PARGET: HRRZ B,(B)
MOVE A,B
ADD A,[440700,,LLDESC]
PARGE0: HRRZ T,TXTCNT(B)
JUMPE T,PARGE3 ;A blank line always starts a new line
TRZ F,REL ;Means no new par.
MOVE T,A ;We will have to test new line indent
SETZ TT,
PARGE1: ILDB C,T ;Count leading spaces
CAIN C,40
AOJA TT,PARGE1
CAIN C,11
JRST PARGE1
TLNE F,TF2 ;Was this a TJ command?
JRST PARGE4 ;Yes
SKIPN BNUMO ;Are blank lines expected?
JRST PARGE2 ;No, so test further
CAMN TT,PMARO ;Exact match with PMARO required in this case
TRO F,REL ;Satisfied
POPJ P,
PARGE2: SUB TT,LMARO ;Get difference
MOVMS TT
CAILE TT,1
PARGE3: TRO F,REL ;Any indent >1 from LMARO taken as indicator
POPJ P,
PARGE4: SKIPN BNUMO ;Are blank lines expected?
JRST PARGE5 ;No, so test further
CAMN TT,TPMARO ;Exact match with PMARO required in this case
TRO F,REL ;Satisfied
POPJ P,
PARGE5: SUB TT,TLMARO ;Get difference
MOVMS TT
CAILE TT,1
TRO F,REL ;Any indent >1 from LMARO taken as indicator
POPJ P,
; For second pass when input line is exhausted
NEXTLI:
HLRZ T,TXTCNT(B)
MOVNI T,(T) ;and do 1's complement of T
ADDM T,@JCPTR(E) ;add this to # in CHARS or ATTSIZ.
SOS @JLPTR(E) ;Subtract 1 from # in LINES or ATTNUM.
MOVE A,B ;Old B value needed in A by FSGIVE
HRRZ B,(B) ;Get line forward pointer
MOVEM B,JPTR ;and put it in JPTR.
MOVSI T,JPTR ;with JPTR location in left half
HLLM T,(B) ;of pointer for line pointed to.
PUSHJ P,FSGIVE ;Give up storage space. (saves B)
MOVE A,B
ADD A,[440700,,LLDESC]
POPJ P,
; Limit neg A so as not to back too far, MOVARR and set A pos
ADJARG: MOVNS A
CAMGE A,ARRL ;Are we trying to go back too far?
JRST ADJAR1
MOVE A,ARRL ;Yes
SUBI A,1
ADJAR1: PUSH P,A
MOVNS A
PUSHJ P,MOVARR ;Now back up
MOVE T,WINLIN
MOVSI TT,WINBIT
ANDCAM TT,TXTFLG(T)
SETZM WINLIN
SETZM TOPWIN
ADJAR2: POP P,A ;Get positive count back
POPJ P,
; Get space for first new line
JNEW: PUSH P,Q
HRRZ Q,(B)
MOVEM Q,JRPT# ;Keep current next line address
CAMN B,PAGE
TRO F,UPDTXT ;This is the first line on the page
HLLZ Q,TXTFLG(B) ;Save flags
HRRZ I,FSEND
ADDI I,1
MOVEM I,JLPT
HLLZ TT,(B) ;Use the left half of old link for
LEG MOVEM TT,(I) ;left half of the new link word, zero right
HLRZ T,TT
HRRM I,(T) ;Fix earlier forward link to the new line
LEG HLLM Q,TXTFLG(I) ;Use old flags
TLNE Q,ARRBIT ;May need to reset ARRLIN
MOVEM I,ARRLIN
TLNE Q,WINBIT ;and also WINLIN
MOVEM I,WINLIN
CAMN B,ARRLIS
MOVEM I,ARRLIS ;Finally fix ARRLIS if necessary
POP P,Q
POPJ P,
; Get space for next output line
JMORE: HRRZ TT,FSEND ;So get space starting address
ADDI TT,1
HRRM TT,(I) ;Complete forward link in finished line
LEG HRLZM I,(TT) ;and back link new line
MOVEM TT,JLPT
MOVE I,JLPT
MOVEI TT,0
LEG HRLM TT,TXTFLG(I) ;This should always be safe
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so replace by I
POPJ P,
;JUFIX JBLANK J2PASS JMSTRT JINIT JPREAD JMREAD
; Introduce CRLF and finish off the line
JUFIX: MOVEI C,15
LEG IDPB C,D ;The CR
MOVEI C,12
LEG IDPB C,D ;And a LF
TDZA C,C
LEG IDPB C,D ;And a null
TLNE D,760000
JRST .-2
MOVSI TT,2(G) ;2 for CRLF + char. count
ADDI TT,(G) ;but only char. count into right half
ADDM TT,TXTCNT(I) ;Record char counts
AOS @JLPTR(E) ;Add to line count (LINES or ATTNUM)
HLRZ T,TXTCNT(I)
ADDM T,@JCPTR(E) ;Add to char count (CHARS or ATTSIZ)
MOVE T,JLPT ;should be same as I
;Display text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert to ASCID
CAIGE T,(D)
AOJA T,.-2
MOVEI TT,2(D)
MOVSI T,TXTCOD
FSFIX TT,T
POPJ P,
; To introduce a blank line
JBLANK:
LEG HRRZS TXTFLG(I) ;Zero flg portion
LEG SETZM TXTCNT(I) ;The 2,,0 will be added by JUFIX
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I)
SETZ G,
MOVE D,I
ADD D,[440700,,LLDESC]
MOVEI C,40
LEG IDPB C,D
PUSHJ P,JUFIX ;Finish off this line
POPJ P,
; Prepare for the second pass
J2PASS: TLO F,TF1 ;Set for second pass
MOVEI DSP,J1DSP ;Always eat initial spaces
MOVSI H,JALL
MOVE T,JMARG ;Get correct current margin value
PUSHJ P,JMSTRT ;Start neew line with this margin
MOVE A,ASAVE
MOVE B,JPTR
POPJ P,
; To start new line with the proper margin
JMSTRT: AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I) ;Assign I new serial number
MOVE D,I ;Set up output char pointer
ADD D,[440700,,LLDESC]
IDIVI T,10 ;See if TABs are to be used
LEG HRLZM T,TXTCNT(I) ;Start new TXTCNT (with credit for any TABs)
JUMPE T,J2PAS3 ;No TABs
PUSH P,Q ;Save Q
MOVEI C,11
J2PAS0:
LEG IDPB C,D
MOVEI C,40
MOVEI Q,10 ;Temporary use only
ADDM Q,TXTCNT(I) ;Count as displayed chars. only
J2PAS1:
LEG IDPB C,D
SOJG Q,J2PAS1
MOVEI C,11
J2PAS2:
LEG IDPB C,D
SOJG T,J2PAS0
POP P,Q ;Restore Q
J2PAS3: JUMPE TT,J2PAS5 ;No extra spaces in JMARG
HRR T,TT
HRL T,TT
ADDM T,TXTCNT(I) ;Count both as stored and as displayed
MOVEI C,40
J2PAS4:
LEG IDPB C,D
SOJG TT,J2PAS4
J2PAS5: POPJ P,
; To determine E and get corrected JCNT and JPTR values
JINIT: TRNE F,ATTMOD ;Are we in ATTACH mode?
SKIPA E,[JATAB] ; Yes so put [JATAB] in E.
MOVEI E,JPTAB ; No so put [JPTAB] in E.
MOVE D,@JPT1(E) ;Put contents of @ATTBUF or @ARRLIN in D.
HRRZM D,JPTR# ;Location of first line to examine
MOVE A,@JLPTR(E) ;Number of lines
TRNE F,ATTMOD
JRST JINIT2
SUB A,ARRL
ADDI A,1
JINIT2: CAMGE A,JCNT
MOVEM A,JCNT ;Limit number of lines to the available ones
POPJ P,
JPREAD: MOVE T,EXTPNT ;To read JPARAM changing instructions.
MOVEM T,TYIPNT ;Set pointer.
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
; Subroutine to read typed-in decimal numbers.
;Returns the number in A, the terminating character in C and
;a count of the number of digits in B.
JPARAM: SETZB A,B
TLZ F,TF1
JPAR0: PUSHJ P,TYI ;Get first character if any
POPJ P,
CAIN C," "
JRST JPAR0 ;Extra space allowed here
AOS (P) ;Skip return if something typed
CAIE C,"-"
JRST JPAR2
TLO F,TF1 ;Signal for a neg number
JPAR1: PUSHJ P,TYI ;Get next character
JRST JPAR3 ;End of typing
JPAR2: CAIG C,71
CAIGE C,60
JRST JPAR3 ;Non numeric character
IMULI A,12
ADDI A,-"0"(C)
AOJA B,JPAR1 ;B used to indicate some number (may be zero)
JPAR3: TLZE F,TF1
MOVNS A
POPJ P,
; To read 4 margin values with possible additional old values
JMREAD: PUSHJ P,JPREAD ;Get ready and read first parameter
POPJ P, ;Nothing typed
MOVSI Q,-4
JRST JMREA2
JMREA0: SKIPE B
MOVEM A,JPMARO(Q) ;Correct old value
JMREA1: PUSHJ P,JPARAM ;Read a parameter
POPJ P, ;Nothing typed
JMREA2: CAMN C,"|" ;Was a "|" separater used, meaning JPMARO (old)
JRST JMREA0 ;No
SKIPE B ;B=0 means no number before symbol
MOVEM A,JPMAR(Q)
CAIE C,40 ;A space or a comma may be used
CAIN C,"," ;Any other symbol terminates JGINIT
AOBJN Q,JMREA1
POPJ P,
;TJIDSP TJ1DSP TJFILL TJUST
; To terminate on a CR
TJ1CR: TLNN F,TF1 ;Is this the first pass
JRST JU3AA ;Yes
JRST JU4A
; To keep odd-even count on tabs and to eat them
TJ1TAB: MOVNS ODDEVN#
JRST J1SP ;MOVNI C,3↔ADDM C,(P)↔POPJ P,
; To exit from loop, on a non-space via TJ1DSP or on two spaces via TJ2DSP
TJ1CH: AOS (P)
AOS (P)
POPJ P,
TJ2TAB: ADD A,[70000,,0] ;Back up so odd-even count will work
CAIG A,0
SUB A,[430000,,1]
SOJA J,TJ2SP1 ;Correct for the AOJ which follows
; To test if there is more than 1 space (indicating the end of an entry)
TJ2SP: MOVE TT,A
ILDB C,TT ;Sneak look at the next character
CAIE C,40
CAIN C,11
SKIPA
POPJ P, ;Single spaces are allowed in tab fields
TJ2SP1: TLNN F,TF1 ;Which pass?
JRST TJ2SP2
MOVEI C,40 ;It could have been a tab
LEG IDPB C,D
LEG IDPB C,D
AOS (P) ;For the extra instruction in second-pass loop
TJ2SP2: AOBJN G,.+1
AOBJP G,.+1
AOJA J,TJ1CH ;Account for 1 char and exit from loop
; Dispatch table to eat to next tab field
TJ1DSP: JRST TJ1CR ;CR
PUSHJ P,TJ1TAB ;TAB (odd-even checked then eaten)
AOS J ;Space (counted to TABENO)
PUSHJ P,TJ1CH ;Punctuation (exit from loop)
PUSHJ P,TJ1CH ;Closure " " "
PUSHJ P,TJ1CH ;Other character " " "
; In-text dispatch table to look for a TAB or a CR
TJ2DSP: JRST TJ1CR ;CR
PUSHJ P,TJ2TAB ;TAB
PUSHJ P,TJ2SP ;SP
JFCL
JFCL
JFCL
; To reformat tables with or without justification of auxillary information
TJFILL: TROA F,NEG
TJUST: TRZ F,NEG
TLO F,TF2 ;Signal that this is a T type command
TLZ F,TF3 ;But not a JSPLIT
PUSH P,A
MOVSI Q,-4
TJUST1: MOVE TT,TPMAR(Q)
MOVEM TT,TPMARO(Q)
SETOM JPMAR(Q)
AOBJN Q,TJUST1
PUSHJ P,JMREAD ;Read typed margin values
MOVSI Q,-4
TJUST2: SKIPL TT,JPMAR(Q)
MOVEM TT,TPMAR(Q)
AOBJN Q,TJUST2
PUSHJ P,TJREAD ;Read typed tab settings
JRST JUST2 ;Use common routine from here on
; Special treatment if new par for TJ case
TJU1: SETZB Q,J
SKIPG TABOLD(Q) ;Are tab fields expected?
JRST JU2 ;No
TJU1A: MOVE K,TPMAR
MOVEM K,TABEND#
SETOM ODDEVN ;To keep odd-even check on tabs
MOVE TT,TPMARO
MOVEM TT,TABENO#
JUMPE TT,TJU3B
TJU2: MOVEI DSP,TJ1DSP
MOVSI H,JALL
SETOM ODDEVN ;To keep odd-even check on tabs
TJU3: ILDB C,A ;Eat spaces, odd-even check tabs, to next field
TJU3A: TLNE H,JCTAB(C)
XCT @JCTAB(C)
CAMGE J,TABENO
JRST TJU3
CAML J,TABENO ;Did we arrive at an entry too soon?
AOJA J,TJU3B ;No
ADD A,[70000,,0] ;Yes, so back up
CAIG A,0
SUB A,[430000,,1]
JRST TJU3C
TJU3B: SKIPG ODDEVN ;Is there an unmatched tab?
JRST TJU3C ;No
ILDB C,A ;Eat the remaining tab
CAIE C,11 ;Verify that it is a tab
JRST TJU3A ;Go back and find it
TJU3C: TLNE F,TF1
JRST TJU6 ;Second pass
; Allow for spaces to be used on second pass
TJU4: CAILE K,(G)
AOBJN G,TJU4
SKIPLE TT,TABOLD(Q)
JRST TJU4A ;Can continue
HRRZM G,JWCOL
AOS JSCNT ;Counts as a word break for justification
JRST JU2 ;Now complete normal first pass
TJU4A: HRRZM TT,TABENO ;New input field end
HRRZ K,TABTAB(Q)
SUB K,TPMAR ;Remember that G is measured from TPMAR
AOS Q
MOVEI DSP,TJ2DSP
MOVSI H,JUSF
TJU5: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
AOS J ;Count input characters
AOBJN G,TJU5
AOJA J,TJU2 ;At end of this entry
; Pad out new line with spaces to next tab field
TJU6: MOVEI C,40
TJU7: CAIG K,(G)
JRST TJU8
LEG IDPB C,D
AOBJN G,TJU7
TJU8: JUMPGE G,JU3AA
SKIPG TT,TABOLD(Q)
JRST JU3AA
HRRZM TT,TABENO ;New input field end
HRRZ K,TABTAB(Q)
SUB K,TPMAR ;Remember that G is measured from TPMAR
AOS Q
MOVEI DSP,TJ2DSP
MOVSI H,JUSF
TJU9: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
AOS J ;Count input characters
LEG IDPB C,D
AOBJN G,TJU9
AOJA J,TJU2 ;At end of this entry
;JSTOP JJSTOP JFILL JUST
JSTOP: TROA F,NEG
JJSTOP: TRZ F,NEG
TLO F,TF3
JRST JUST0
JFILL: TROA F,NEG ;For JFILL case
JUST: TRZ F,NEG ;For JUST case
TLZ F,TF2!TF3 ;Neither a TJ nor a JSPLIT command
;THIS IS PLACE TO PUT MARGIN ACCEPT AND REPORT, IF 0 VALUE FOR A
JUST0: PUSH P,A
MOVSI Q,-4
SETOM JPMAR(Q)
AOBJN Q,.-1
PUSHJ P,JMREAD ;Read typed margin values
MOVSI Q,-4
JUST1: SKIPL T,JPMAR(Q)
MOVEM T,PMAR(Q)
AOBJN Q,JUST1
JUST2: PUSHJ P,ENDSET ;So new data will be at end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
MOVE A,ARRLIN
MOVEM A,ARRLIS# ;Save so we can reset arrow when done
MOVE A,TOPWIN
MOVEM A,TOPWIS#
POP P,A
TRNN F,ARG!ATTMOD
JRST JU0A ;Start at beginning of page and do entire page
TRNN F,ARG
JRST JU0B ;Do entire ATTACH buffer
TRNN F,ATTMOD
JRST JU0 ;Still have to worry about a neg arg
JUMPG A,JU1
MOVNS A ;Neg argument if attached has no meaning
JRST JU1
JU0: JUMPG A,JU1
PUSHJ P,ADJARG ;Adjust A to start earlier and do thru init. ARRL
JRST JU1
JU0A:
PUSHJ P,SETARR ;Start at beginning of page
MOVE T,WINLIN
MOVSI TT,WINBIT
ANDCAM TT,TXTFLG(T)
SETZM WINLIN
SETZM TOPWIN
JU0B: MOVEI A,-1
JU1: MOVEM A,JCNT ;Tentative line count
TRZ F,ARG ;This is used later to signal the end of data
PUSHJ P,JINIT ;Set E, get JPTR, and correct JCNT value
MOVSI H,JALL ;Set to dispatch on all characters
MOVEI DSP,J1DSP ;Set dispatch for new output line
MOVE B,JPTR
TRZ F,REL ;Means not new par. on first pass
SETZM JBUGR ;Bugger factor that staggers inserted spaces
JU1A: HRRZ C,TXTCNT(B) ;Is this line blank?
JUMPN C,JU1B ;No
HRRZ B,(B) ;Skip over it
MOVEM B,JPTR ;Initial blank lines are left but signal new par
SOSG JCNT ;One less line to process
JRST JU8
TRO F,REL ;Means new par. indent to start
JRST JU1A
JU1B: PUSHJ P,JNEW ;Get space for new lines and fix flags etc.
TRNN F,REL ;Alrready know that new par. indent is to be used
PUSHJ P,PARGE0
JU1C: MOVE A,B
ADD A,[440700,,LLDESC]
JU1D: TLNE F,TF2 ;Was this a TJ command
JRST JU1E ;Yes
MOVE G,LMAR
TRNE F,REL ;No new par indent if 0
MOVE G,PMAR
MOVEM G,JMARG ;Save as current margin for second pass
SUB G,RMAR
JRST JU1F
JU1E: MOVE G,TLMAR
TRNE F,REL ;No new par indent if 0
MOVE G,TPMAR
MOVEM G,JMARG ;Save as current margin for second pass
SUB G,TRMAR
JU1F: MOVNM G,JSIZE ;The expected size of new line less margin
SUBI G,1 ;Go 1 char. beyond on the first pass
HRLZS G
MOVEM A,ASAVE
SETZM JSCNT ;To count word separators
MOVE C,JCNT
MOVEM C,JCNTC
TLNE F,TF2
TRNN F,REL
SKIPA
JRST TJU1 ;Go to TJ routine if TJ command and new par
JU2: MOVEI DSP,J1DSP ;Always eat initial spaces
MOVSI H,JALL
TLZ F,TF1 ;Set for first pass
TRZ F,REL ;Must be redetermined during first pass
;First pass
; Determine accepted-char. count, # of word separators and par. conditions
JU3: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C) ;Caution, return may be .-2, ., .+1 or .+2
AOBJN G,JU3
SKIPN JSCNT ;Have we come to a word break?
JRST JU3 ;Impossible to break line so go on
JU3AA: SETZM JSINC ;Safety precaution only
; Verify par. conditions
TRNE F,REL ;Have we already determined par. conditions?
JRST JU3D ;Yes
LDB C,A ;GET last char. back
CAIN C,15 ;Was it a CR?
JRST JU3B ;YES, so no further testing needed
SKIPA
JU3A: ILDB C,A
CAIE C,40
CAIN C,11
JRST JU3A ;Eat all spaces and TABs
CAIE C,15 ;Now do we find a CR?
JRST JU3B ;No, so some text is left
PUSHJ P,PARGET ;Yes, so look at next line
JU3B: TRNN F,NEG!REL ;Is this a JFILL or a last line of par.
SOSG JSCNT ;Do not count final word ending
JRST JU3D ;Line must be left un-justified
; Prepare for justification
MOVE T,JSIZE
SUB T,JWCOL
LSH T,3 ;Multiply by 8
MOVEM T,JSINC
MOVN G,JSIZE
SETZM JSIZE ;Used in the JUSPAD routine for accumulated JSINC
SETZM JWPT ;Used in JUSPAD for accumulated insertions
SKIPA
JU3D: MOVN G,JWCOL ;Un-justified case
HRLZS G
PUSHJ P,J2PASS ;Set-up for the second pass
SETZB Q,J
TLNE F,TF2 ;Is this a TJ command?
SKIPG TABOLD(Q) ;and are there any tab fields
SKIPA ;No
JRST TJU1A
; Main character transfering loop
JU4: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C) ;Caution, return may be to .-2, ., or .+1
LEG IDPB C,D
AOBJN G,JU4
JU4A: PUSHJ P,JUFIX ;Fix up line just finished
TRNE F,ARG ;Is text exhausted?
JRST JU6D ;Yes
TLZ F,TF1 ;Get set for new first pass
TLNE F,TF3 ;Was it a JS command?
TRZ F,REL ;Yes, so suppress par. action
TRNE F,REL ;Is it to be a new par?
SKIPN Q,BNUM ;Will blank lines be needed?
JRST JU6 ;No
; Introduce needed blank lines
JU5: PUSHJ P,JMORE ;Get space for it
PUSHJ P,JBLANK ;Introduce blank line
SOJG Q,JU5
; A new input line may be needed
JU6: MOVE T,A
JU6A: ILDB C,T
CAIE C,40
CAIN C,11
JRST JU6A ;Eat all spaces and TABs
CAIE C,15 ;Is it a CR?
CAIN C,12 ;We might have gotten by the CR
JRST JU6B ;A new input line is needed
JRST JU6C ;There is still some text left
JU6E: CAMN B,ARRLIS
MOVEM I,ARRLIS
JU6B: PUSHJ P,NEXTLI
SOSG JCNT
JRST JU7 ;WOOPS! we are through
HRRZ T,TXTCNT(B) ;Is the next line blank?
JUMPE T,JU6E ;Yes, so eat it
JU6C: PUSHJ P,JMORE ;Get space for next output line
JRST JU1D
JU6D: PUSHJ P,NEXTLI ;Give up final old line
;Complete the links to the following text
JU7: MOVE T,JLPT ;Now fix new right link
HRRM B,(T) ;A references next line
HRLM T,(B) ;And backward link to the new line
TRO F,WRITE!DSPALL
JU8: PUSHJ P,ENDFIX
TLZ F,NOCHK
TRNE F,ATTMOD
JRST JU9 ;Arrow was not moved in this case
MOVE B,PAGE
MOVEI A,1
JU8A: CAMN B,ARRLIS
JRST JU8B
HRRZ B,(B)
CAIE B,BOTSTR
AOJA A,JU8A
AOS A
JU8B: PUSHJ P,SETARR
MOVE A,TOPWIS
PUSHJ P,SETWIN
JU9: JRST JEXIT(E)
;IND INDENT CENTER ALIGN LFARR RTARR
; Common routine used by CENTER, INDENT etc. with proper dispatch value in DSP
IND: SETZM JBUGR ;Normal case where TABs are replaced by spaces
CAIE C,"T" ;Was the TAB flag typed?
CAIN C,"t"
SETOM JBUGR ;Signals retention of internal TABs
PUSHJ P,ENDSET ;So new data will be at end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
MOVE A,ARRLIN
MOVEM A,ARRLIS# ;Save so we can reset arrow when done
MOVE A,TOPWIN
MOVEM A,TOPWIS#
POP P,A ;The initial argument saved by CENTER or INDENT
TRNE F,ATTMOD
JRST IND2
JUMPGE A,IND3
PUSHJ P,ADJARG ;Adjust argument and back up if neg
JRST IND3
IND2: SKIPGE A
MOVNS A ;NEG value has no meaning if in ATTACH
TRNN F,ARG
MOVEI A,-1 ;Do entire ATTACH buffer if no argument
IND3: MOVEM A,JCNT ;Tentative count of lines to process
PUSHJ P,JINIT ;Set E, get JPTR and correct JCNT
MOVE B,JPTR
IND4: HRRZ C,TXTCNT(B) ;Is this a blank line?
JUMPN C,IND4A
HRRZ B,(B)
SOSG JCNT
JRST JU8 ;No non-blank lines (finish off as in JUST)
JRST IND4 ;Delay starting until first non-blank line
IND4A: PUSHJ P,JNEW ;Get space for first line
IND5: SETZ T, ;Used to count leading spaces
MOVEM C,JWCOL ;Save character count for use in CENTER
MOVE A,B
ADD A,[440700,,LLDESC]
MOVSI G,-77777
MOVEI DSP,J4DSP
MOVSI H,JALL
SETZ T,
; Main loop
IND6: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
LEG IDPB C,D
AOBJN G,IND6
PUSHJ P,JUFIX ;Add CRLF and finish off this line
IND7: PUSHJ P,NEXTLI
SOSG JCNT
JRST JU7 ;No more lines (finish as for JUST)
PUSHJ P,JMORE ;Get space for nest line
HRRZ C,TXTCNT(B) ;Is the next line blank?
JUMPG C,IND5
PUSHJ P,JBLANK ;Put in the blank line
JRST IND7
INDENT: PUSH P,A ;Will be restored in IND
PUSHJ P,JPREAD
SKIPA ;Use default value
MOVEM A,INMAR
MOVEI Q,0 ;Signal to J4CH to use INDENT margin code
JRST IND
CENTER: PUSH P,A
MOVSI Q,-4
SETOM JPMAR(Q)
AOBJN Q,.-1
PUSHJ P,JMREAD ;Read typed margin values
MOVSI Q,-4
CENT0: SKIPL T,JPMAR(Q)
MOVEM T,PMAR(Q)
AOBJN Q,CENT0
MOVE T,RMAR
SUB T,LMAR
MOVEM T,JSIZE ;Use for centering
MOVEI Q,1 ;Signal to J4CR to use CENTER margin code
JRST IND ;use same routine as INDENT
; ALIGN command aligns all specified lines at a fixed left margin
ALINE:
ALIGN: PUSH P,A
PUSHJ P,JPREAD
JRST ALIGN2
SKIPGE A
SETZ A,
MOVEM A,AMAR
ALIGN2: MOVEI Q,2 ;Signal to J4CH to use code for ALIGN
JRST IND
; Moves the specified lines right by the (absolute) INMAR value
RTARR: PUSH P,A ;Will be restored in IND
MOVEI Q,3
JRST IND
; Moves the specified lines left by the (absolute) INMAR value
LFARR: PUSH P,A ;Will be restored in IND
MOVEI Q,4
JRST IND
JLEFT: OUTSTR [ASCIZ/Not defined/]
popj p,
;JGINIT JGB JGIND JGMAR JGET
; Subroutine called by JGET and TJGET
;to clear PAR table and to read and store typed-in MAR values.
JGINIT: TRNN F,ARG
HRRZI A,-1 ;Use rest of page (or buffer) if no argument
MOVMM A,JCNT
JUMPE A,JGIN1 ;No text referencing
MOVSI Q,-4
SKIPN JCNT
JRST JGIN1 ;Leave old values if JCNT=0 and no typed value
SETOM JPMAR(Q)
AOBJN Q,.-1
PUSHJ P,JINIT ;Set E and get proper JPTR and JCNT values
MOVN G,JCNT
HRLZS G
MOVEM G,GSAVE# ;May be needed again later
JGIN1: PUSHJ P,JMREAD
POPJ P,
; Subroutine called by JGMAR
;Will locate the first non-blank line after 1 or more blank lines and
;return the number of blank lines in B (B set to 0 before entry).
;Pointer to the first line of text in D and the specification of the number
;of lines of text (as a negative number) in the left of G.
JGB0: HRRZ D,(D)
JGB: HRRZ C,TXTCNT(D)
JUMPN C,JGB1
AOJA B,JGB2 ;Count blank lines for JBNUM
JGB1: CAMLE C,Q
MOVE Q,C ;Put largest in Q for JRMAR
JUMPE B,JGB2
MOVEM B,JBNUMO ;Save it here always
SKIPGE JBNUM ;Was a JBNUM typed in?
MOVEM B,JBNUM ;No, so use this value
MOVEM G,GSAVE ;May be needed twice
MOVEM D,JPTR ;Save new starting place in text
JRST JGB1B
JGB1A: HRRZ D,(D) ;Go to end for Q determination
HRRZ C,TXTCNT(D)
CAMLE C,Q
MOVE Q,C
JGB1B: AOBJN G,JGB1B ;Are we at the end?
MOVE G,GSAVE ;Reset for first line after blanks
MOVE D,JPTR
POPJ P, ;Text found after a blank line
JGB2: AOBJN G,JGB0 ;Still looking
MOVE D,JPTR ;No text found after blank line, so reset
MOVE G,GSAVE
SETZ B, ;Blank lines without text following, do not count
MOVEM B,JBNUMO ;Save it here always
SKIPGE JBNUM ;Was a JBNUM typed in?
MOVEM B,JBNUM ;No, so use this value
PUSHJ P,JGIND ;Get first line indent
HRRZ TT,T ;Save it
JGB3: AOBJP G,JGB4
HRRZ D,(D) ;Try the next line
PUSHJ P,JGIND
CAIN TT,(T)
AOJA B,JGB3 ;Another line with the same indent
JUMPE B,JGB4 ;More than 1 line with same indent?
MOVEM G,GSAVE
MOVEM D,JPTR
POPJ P,
JGB4: MOVE G,GSAVE ;Go back to first line if B still zero
MOVE D,JPTR
POPJ P,
;To get indentation
JGIND: HRRZ T,TXTCNT(D)
MOVNS T
HRLZS T
MOVE A,D
ADD A,[440700,,LLDESC]
JGIND1: ILDB C,A
CAIN C,11 ;Is it a TAB?
JRST JGIND1 ;Ignore it
CAIN C," " ;Is it a space?
AOBJN T,JGIND1 ;Count it
POPJ P,
; Subroutine called by JGET and TJGET
;To determine margins from specified text
JGMAR: MOVN G,JCNT
HRLZS G
MOVEM G,GSAVE ;May be needed twice
SETZB B,Q ;B counts blank lines, Q gets JRMAR
MOVE D,JPTR ;Pointer to the first line of text
PUSHJ P,JGB ;Find paragraph start
PUSHJ P,JGIND ;Get its indentation
MOVEM T,INDCNT# ;May be needed for TJGET case
MOVEM A,ASAVE# ;and also pointer to first non-blank character
HRRZM T,JPMARO ;Save it always
SKIPGE JPMAR ;Was a new value typed?
HRRZM T,JPMAR ;No, so use this value
AOBJN G,JGM0 ;Trouble, not enough lines
SETZM JBNUMO ;Maybe he wants 1 paragraph
JRST JGMA
JGM0: HRRZ D,(D)
PUSHJ P,JGIND ;Get indentation of the next line
JGMA: HRRZM T,JLMARO
SKIPGE JLMAR ;Was a new value typed?
HRRZM T,JLMAR ;No, so save this value
SKIPG JRMAR ;Was a new JRMAR typed in?
MOVEM Q,JRMAR ;No, so save this value
POPJ P,
;To test margins for legality
JMTEST: MOVE A,JPMAR
CAME A,JLMAR
JRST JMTES1
SKIPLE JBNUM
JRST JMTES1
MOVEI T,1
MOVEM T,JBNUM ;Must be ≥1 in this case
OUTSTR [ASCIZ/BNUM set to 1./]
JMTES1: CAMG A,JLMAR
MOVE A,JLMAR
ADDI A,MINTXT ;Minimum text length
CAMG A,JRMAR
POPJ P,
MOVEM A,JRMAR
OUTSTR [ASCIZ/ RMAR set to /]
TYPDEC A
OUTSTR [ASCIZ/ /]
POPJ P,
;Get typed-in margins and/or values identified from the specified text.
JGET: JUMPN A,JGET2
MOVSI Q,-4
JGET1: MOVE T,PMAR(Q)
MOVEM T,JPMAR(Q)
AOBJN Q,JGET1
JGET2: PUSHJ P,JGINIT ;Initialize and get typed-in margin values
CAIN C,";" ;To avoid confusion with TJGET
OUTSTR [ASCIZ/Caution, no TAB values allowed with JGET command./]
SKIPE JCNT
PUSHJ P,JGMAR ;Get margins by examining the text
OUTSTR [ASCIZ/Margins (P,L,R,B) are /]
SKIPE JBNUMO ;Were there no blank lines in text?
JRST JGET2A
MOVE A,JPMARO
CAMN A,JPMAR ;Is PMAR being changed?
JRST JGET2A
TYPDEC A ;Report it
OUTSTR [ASCIZ/|/]
JGET2A: MOVSI G,-4
SETZM TYOPNT
SKIPA
JGET3: OUTSTR [ASCIZ/,/]
MOVE A,JPMAR(G)
MOVEM A,PMAR(G)
MOVEM A,PMARO(G)
TYPDEC A
AOBJN G,JGET3
OUTSTR [ASCIZ/. /]
AOS (P)
POPJ P,
;TJREAD TJGET
; To read typed tab values
TJREAD: CAIE C,";"
CAIN C,"!"
SKIPA
JRST TJG8 ;No typed TAB values
MOVSI Q,-TABCNT
HLLZS TABTAB(Q) ;Zero indent values only
AOBJN Q,.-1
TJG2: MOVSI Q,-TABCNT
CAIN "!"
JRST TJG4A ;Next number is to be an indent not a field size
TJG3: PUSHJ P,JPARAM
JRST TJG8 ;A ; typed but no data
CAIE C,"@" ;Is this a multiple define
JRST TJG5
MOVE H,A ;Yes, so save repetition number in H
PUSHJ P,JPARAM ;and get field size
SETZ A,
TJG4: SKIPE A ;A zero or missing value means leave unchanged
HRLZM A,TABTAB(Q)
AOBJP Q,TJG7A ;No more space so ignore the rest
SOJG H,TJG4
JRST TJG6 ;See if there are any more
TJG4A: PUSHJ P,JPARAM ;Get indent value
SKIPA ;Syntax error
JUMPG A,TJG4B ;An indent can not be zero
OUTSTR [ASCIZ/IMPROPER SYNTAX, a non-zero number must follow a "!" symbol/]
POPJ P,
TJG4B: HRRZM A,TABTAB(Q)
AOBJP Q,TJG7A
JRST TJG6
TJG5: JUMPE B,TJG6 ;Was a number typed?
HRLZM A,TABTAB(Q) ;Yes, so save it as a field length
TJG6: CAIN C,","
JRST TJG3
CAIN C,"!"
JRST TJG4A
SKIPA
TJG7A: OUTSTR [ASCIZ/ Too many TABs typed, will ignore rest. /]
TJG7: CAIE C,"Z"
CAIN C,"z"
SETOM TABTAB(Q) ;Zero (make neg) any remaining fields
TJG8: POPJ P,
; To adjust right half fields of TABTAB to reflect all typed changes
TJADJ: MOVSI Q,-TABCNT ;Must be entered with margin value in TT
TJADJ1: SKIPG TABTAB(Q)
POPJ P, ;No more values specified
HLRZ T,TABTAB(Q)
JUMPG T,TJADJ3 ;A field length was specified
HRRZ T,TABTAB(Q) ;An indent was specified
SUB T,TT
CAIL T,MINTXT
JRST TJADJ2
OUTSTR [ASCIZ/ TAB field #/]
HRRZ C,Q
TYPDEC C
OUTSTR [ASCIZ/ set at min. length of /]
MOVEI T,MINTXT
TYPDEC T
OUTSTR [ASCIZ/. /]
TJADJ2: HRLM T,TABTAB(Q)
TJADJ3: ADD TT,T
HRRM TT,TABTAB(Q) ;May have been corrected
AOBJN Q,TJADJ1
POPJ P,
;Get margins and also TAB settings, both as typed in and from text
TJGET: JUMPN A,TJGB
MOVSI Q,-4
TJGA: MOVE T,TPMAR(Q)
MOVEM T,JPMAR(Q)
AOBJN Q,TJGA
TJGB: PUSHJ P,JGINIT ;Initialize and get typed margin values
MOVSI Q,-TABCNT
SKIPG JCNT
JRST TJG1
SETZM TABTAB(Q) ;Set TABTAB to 0 if JCNT>0
AOBJN Q,.-1
TJG1: PUSHJ P,TJREAD
SKIPN JCNT ;Are values to be deduced from the text?
JRST TJG18 ;No
PUSHJ P,JGMAR ;Get margins from the text
MOVSI Q,-TABCNT
MOVE A,ASAVE ;Get back to the first non-space char in 1st line
MOVE G,INDCNT ;Get character counter for first non-space
TJG8B: SETZ T,
TJG8C: SETZ H,
TJG8D: AOS T ;We start on the first char
ILDB C,A
CAIE C," "
CAIN C,11
JRST TJG11
AOBJN G,TJG8D
JRST TJG15
;To count spaces or TABS to check field termination
TJG9A: AOS H
TJG9: AOS T
TJG10: ILDB C,A ;A space or TAB found, is there another one?
TJG11: CAIE C," " ;Is it a space?
JRST TJG12
AOBJN G,TJG9A
JRST TJG15
TJG12: CAIN C,11 ;or a TAB?
AOJA H,TJG10 ;TABs do not count in G or T, but add to H
CAIL H,TJSCNT ;Were there JSCNT or more spaces?
JRST TJG13 ;Yes, so at end of this TAB field
AOBJN G,TJG8C ;Single spaces allowed within fields
JRST TJG15
TJG13A: OUTSTR [ASCIZ/ Only /]
MOVEI A,TABCNT
TYPDEC A
OUTSTR [ASCIZ/ TABS allowed. /]
JRST TJG15
TJG13: SKIPG TABTAB(Q) ;Has this TAB been typed in?
HRLZM T,TABTAB(Q) ;Save field length
AOBJP Q,TJG13A
AOBJN G,TJG8B
TJG15: MOVE TT,JPMAR
PUSHJ P, TJADJ ;Adjust all tab values to reflect corrections
TJG18: OUTSTR [ASCIZ/T type margins P,L,R,B) are /]
SETZM TYOPNT
MOVSI Q,-4 ;Report values
SKIPA
TJG19: OUTSTR [ASCIZ /,/]
MOVE T,JPMAR(Q)
MOVEM T,TPMAR(Q)
TYPDEC T
AOBJN Q,TJG19
OUTSTR [ASCIZ/. /]
HRLI T,TABTAB
HRRI T,TABOLD
BLT T,TABOLD+TABCNT-1
SKIPG TABTAB ;Are there any TABS?
JRST TJG23
OUTSTR [ASCIZ/
TAB fields /]
MOVSI Q,-TABCNT
SKIPA
TJG20: OUTSTR [ASCIZ/,/]
SETZ H,
HLRZ T,TABTAB(Q)
TJG20A: HLRZ TT,TABTAB+1(Q)
CAME T,TT
JRST TJG20B
AOS H
AOBJN Q,TJG20A
TJG20B: JUMPE H,TJG20C
AOS H ;The first one was not counted
TYPDEC H ;Count of similar fields
OUTSTR [ASCIZ/@/]
TJG20C: TYPDEC T
SKIPLE TABTAB+1(Q)
AOBJN Q,TJG20
TJG21: OUTSTR [ASCIZ/ starting at /]
MOVE T,JPMAR
ADDI T,1
TYPDEC T
MOVSI Q,-TABCNT
TJG22: OUTSTR [ASCIZ/,/]
HRRZ T,TABTAB(Q)
ADDI T,1
TYPDEC T
SKIPLE TABTAB+1(Q)
AOBJN Q,TJG22
OUTSTR [ASCIZ/. /]
AOS (P)
POPJ P,
TJG23: OUTSTR [ASCIZ/ No TABs specified./]
POPJ P,
;BREAK JOIN
;To break a specified number of lines into fragments ≤BREAKV in length
BREAK: TLZ F,JOINF ;Not to be a JOIN
MOVEM A,JCNT ;Number of lines, default value is 1
MOVE T,EXTPNT ;To read break length if specified
MOVEM T,TYIPNT ;Set pointer.
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
SETZB A,C
BREAK0: PUSHJ P,TYI ;Get first character if any.
JRST BREAK4 ;We are to use default value
CAIN C," "
JRST BREAK0 ;Ignore an extra space in here.
BREAK1: CAIG C,71
CAIGE C,60
JRST BREAK3
IMULI A,12
ADDI A,-"0"(C)
PUSHJ P,TYI
JRST BREAK2
JRST BREAK1
BREAK2: JUMPG A,BRK2A
SORRY BREAK length of 0 not allowed.
JRST POPJ1
BRK2A: CAILE A,377770
MOVEI A,377770 ;This should be large enough!
MOVEM A,BREAKV ;Break value is always sticky
BREAK4: SKIPLE JCNT ;Non-positive arg means just tell default value
JRST JOIN0 ;BREAK something now
OUTSTR [ASCIZ /Default BREAK length is now /]
SETZM TYOPNT
TYPDEC BREAKV
OUTSTR [ASCIZ /. /]
JRST POPJ1 ;Abort on 0 or neg argument
BREAK3: SORRY Only digits permitted in following arg.
SETZM TYIPNT
JRST POPJ1
;To join a specified number of lines into 1 continuous line of arbitrary max length
JOIN: TRNN F,ARG
MOVEI A,2
JUMPG A,JOIN0A
SORRY JOIN argument must be positive.
JRST POPJ1 ;Abort on 0 or neg argument
JOINPM: SORRY Cannot JOIN or BREAK a non-text line.
JRST POPJ1
JOIN0A: MOVEM A,JCNT
TLO F,JOINF ;Set JOIN flag
JOIN0: TRNE F,ATTMOD ;Don't care about arrow line if doing attach buffer
JRST JOIN0B
TLNE F,PMLIN!OFFEND
JRST JOINPM ;Current line is pagemark
JOIN0B: PUSHJ P,ENDSET ;To guarentee that new line will be at the end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
TRNE F,ATTMOD ;Are we in ATTACH mode?
SKIPA E,[JATAB] ; Yes so put [JATAB] in E.
MOVEI E,JPTAB ; No so put [JPTAB] in E.
HRRZ A,@JPT1(E) ;Put right of @ATTBUF or @ARRLIN in A
MOVEM A,JPTR ;Address of link word for first line of text
HLLZ Q,TXTFLG(A) ;Save flags
;Link up start of new area in place of the old
HRRZ H,FSEND
ADDI H,1
TLNE F,JOINF
JRST JOINB ;Join bypass
JOINA: HRRZ T,TXTCNT(A) ;Get size of the line
CAMLE T,BREAKV ;Is line short enough already?
JRST JOINB ;No
SETZ Q, ;Yes, next line cannot be ARRL
HRRZ A,(A) ;Go to it
MOVEM A,JPTR ;Reset for later FSGIVE
CAME A,JETST(E) ;Are we at the end?
SKIPGE TXTFLG(A)
JRST JOINA1
SOSLE JCNT ;or has count run out?
JRST JOINA ;Maybe better luck next time
JOINA1: PUSHJ P,ENDFIX
TLZ F,NOCHK
OUTSTR [ASCIZ /No lines broken. /]
AOS (P)
POPJ P, ;Nothing to do
JOINB:
LEG HLLM Q,TXTFLG(H) ;Use old flags
TLNE Q,ARRBIT ;May need to reset ARRLIN
MOVEM H,ARRLIN
TLNE Q,WINBIT ;and also WINLIN
MOVEM H,WINLIN
SETZ Q,
MOVEM H,JLPT
HLLZ TT,(A) ;Use the left half of old link for
LEG MOVEM TT,(H) ;left half of the new link word, zero right
HLRZ T,TT
HRRM H,(T) ;Fix earlier forward link to the new line
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H) ;Assign H new serial number
ADD H,[440700,,LLDESC] ;Pointer for depositing text
CAIN T,PAGE
TRO F,UPDTXT ;This is the first line on the page
MOVN B,BREAKV ;Set for BREAK
TLNE F,JOINF
MOVEI B,400000 ;Set very large for JOIN
HRLZS B
SETZ G,
JOIN1A: SETZ I, ;To accumulate counts for null line detection
JOIN1: HRRZ T,TXTCNT(A) ;Is this a null line?
JUMPE T,JOIN4 ;Null line bypass
MOVE D,A
ADD D,[440700,,LLDESC] ;Pointer to read text
ADD I,T
JRST JOIN3
;Transfer text, counting chars and fixing up TABs
JOIN2:
LEG IDPB C,H
JOIN3: ILDB C,D
CAIN C,11 ;Is it a TAB?
JRST JOIN5 ;Yes
CAIN C,15
JRST JOIN4
AOBJN B,JOIN2
JOIN2A:
LEG IDPB C,H ;Not a CR so save it
MOVE TT,D
ILDB C,TT ;Sneak a look at next char
CAIE C,15 ;Is it a CR?
JRST JOIN6A ;No, so there is something to break off
TLO B,400000 ;Nothing willl be left so make B neg
JOIN4: AOS Q
;Test for end of text and fix up for next line
HRRZ A,(A) ;Look at next line
SKIPL TXTFLG(A)
CAMN A,JETST(E) ;Are we at BOTSTR or ATTBUF?
SETZM JCNT ;This is needed later
SOSLE JCNT ;Have we joined the specified number of lines?
TLNN F,JOINF ;Or is it a CR for a BREAK?
JRST JOIN6 ;Yes
SOS @JLPTR(E) ;1 line removed from LINES or ATTNUM
SOS @JCPTR(E) ;But correct CHARS or ATTSIZ now
SOS @JCPTR(E) ;for both CR and LF that will be deleted
JRST JOIN1
;Routine for fixing TABs
JOIN5: ILDB C,D ;Yes
CAIN C,40
JRST .-2 ;Eat original spaces
; CAIE C,11 ;Spaces should terminate in a TAB
; OUTSTR [ASCIZ /TAB trouble, inspect text carefully for char omission. /]
;Now put in correct number of spaces for deposited position in line
LEG IDPB C,H ;Deposit as initial TAB
HRROI TT,-10
IORI TT,(B)
HRLS TT ;So that B-left is properly updated
SUB B,TT
ADDI G,(TT)
MOVEI T,40
JRST .+11(TT)
REPEAT 10,<LEG IDPB T,H>
AOS G
JUMPL B,JOIN2 ;Jump if have room for more in this line
JRST JOIN2A
;JOIN6 finishes off the line
JOIN6: JUMPG I,JOIN6A ;Not a null line
MOVEI C,40
LEG IDPB C,H ;At least 1 char is required
MOVSI B,-1 ;Mark input line as used up, output line as empty
JOIN6A: MOVEI C,15
LEG IDPB C,H ;The CR
MOVEI C,12
LEG IDPB C,H ;And a LF
TDZA C,C
LEG IDPB C,H ;And a null
TLNE H,760000
JRST .-2
MOVE T,JLPT
ADDI G,2(B)
HRLZS G
ADDI G,(B)
LEG MOVEM G,TXTCNT(T) ;Record char counts
;Text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert text words to ASCID
CAIGE T,(H)
AOJA T,.-2
MOVEI TT,2(H)
MOVSI T,TXTCOD
FSFIX TT,T
SKIPG JCNT ;Have we exhausted the input?
JRST JOIN7 ;Yes, (will always be so if here on a JOIN)
BREAK6: MOVE T,JLPT ;We will need more space
HRRZ H,FSEND
ADDI H,1 ;Get its start
HRRM H,(T) ;and link it to last piece
LEG HRLM T,(H)
MOVEM H,JLPT
MOVE T,B ;Save for test
MOVN B,BREAKV ;Reset counters
TRNN F,ARG!REL ;If no argument given to BREAK,
MOVEI B,400000 ; then make sure we don't break the line again
HRLZS B
SETZ G,
LEG HRLM G,TXTFLG(H) ;Broken-off piece or next line cannot be ARRL
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H)
ADD H,[440700,,LLDESC]
JUMPL T,JOIN1A ;There was at a CR in original text so reset
AOS @JLPTR(E) ;An extra line will be added
AOS @JCPTR(E) ;And 2 extra chars
AOS @JCPTR(E)
JRST JOIN3
;And complete the links to the following text
JOIN7: MOVE T,JLPT ;Now fix new right link
HRRM A,(T) ;A references next line
HRLM T,(A) ;And backward link to the new line
PUSHJ P,ENDFIX
;It should be safe to FSGIVE now, count is in Q
MOVE A,JPTR ;Get back address of first old line
JUMPE Q,.+4
PUSHJ P,FSGIVE ;And give up its space
HRRZ A,(A)
SOJG Q,.-2 ;Do this for all the old lines
TRO F,WRITE!DSPALL
TLZ F,NOCHK
TLNN F,JOINF ;No message on a break
JRST JEXIT(E)
MOVE T,JLPT ;Restore T value
HRRZ B,TXTCNT(T) ;and check final length of joined line
SETZM TYOPNT
OUTSTR [ASCIZ /Line now has /]
TYPDEC B
OUTSTR [ASCIZ / chars. /]
AOS (P)
JRST JEXIT(E)
;SHIFTY
;This routine tests all lines of text that are in the ATTACH buffer for
;the presence of a space or a TAB in the first chararacter as a prelude
;to the execution of left shift.
SHIFTY: HRRZ D,[ATTBUF] ;Needed for completion test.
MOVE T,(D) ;Get starting location
SHFTY1: MOVE A,[350700,,3(T)] ;Pointer to the first word of text
LDB C,A ;and the first character
CAIE C,40 ;Is it a space?
CAIN C,11 ;or maybe a TAB?
JRST .+2 ;Good!
JRST SHFTY2 ;Too bad, give message and return
CAIN D,(T) ;Are we through?
AOJA P,SHFTY3 ;Yes, so use second return
MOVE T,(T) ;Go to next line of text
JRST SHFTY1 ;and go on
SHFTY2: SORRY One line (at least) is as far as it can go.
SHFTY3: POPJ P,
;MACRO FREE STORAGE - MFSCLR,GETMFS,FREMFS
IFN MACDWP,< ;Poole's macro stuff
SMFS←300 ;Size in blocks of macro free storage.
MFSBS←←6 ;Size of blocks in macro free stg.
ARRAY MACFS[smfs*mfsbs] ;Free storage space for macros.
MFSCLR: MOVEI B,SMFS ;CONS up a macro free stg. list.
MOVEI C,MACFS+MFSBS-1
MOVEM C,MFSPNT# ;Ptrs. are to last word of block...
MFSCL1: ADDI C,MFSBS
MOVEM C,-MFSBS(C)
SOJG B,MFSCL1
MOVEI B,[0]
MOVEM B,-MFSBS(C) ;List ends with ptr. to 0.
POPJ P,
GETMFS: SKIPN A,@MFSPNT ;Get a block of macro free stg.
HALT ;None.
EXCH A,MFSPNT
PUSH P,A ;This is a ptr. to last word of block.
SUBI A,MFSBS-2 ;Set all words of block to -1.
HRLI A,-1(A)
SETOM -1(A)
BLT A,@(P)
POP P,A
SETZM (A) ;Make last word 0.
SUBI A,MFSBS-1 ;Get ptr. to first word.
POPJ P,
FREMFS: ADDI A,MFSBS-1 ;Return a block to the free list. (A should pt. to 1st wd.)
EXCH A,MFSPNT
MOVEM A,@MFSPNT
POPJ P,
>;MACDWP
;MACTYI
IFN MACDWP,<
MACTYI:
MOVEM A,MACTMP#
SKIPE MXCTPT#
JRST MTYIX
MTYIDO: POP P,A
AOS (P)
XCT 40
SOS (P)
MTYIX2: PUSH P,A
CALLI A,400064 ;A real SNEAKS
JRST .+3 ;Nothing there--can't be a 400
CAIN A,400 ;Ignore 400s invented by EMODE
TTYUUO 0,A ;Read the 400 and throw it away
MOVE A,@MACTMP
CAIN A,MESCPC
JFCL MESCP
SKIPN MDEFPT# ;Are we defining a macro ?
JRST POPAJ
DPB A,MDEFPT
ILDB A,MDEFPT
JUMPN A,POPAJ
PUSHJ P,GETMFS
HRRM A,@MDEFPT
TLO A,331100
MOVEM A,MDEFPT
JRST POPAJ
MTYIX: ILDB A,MXCTPT
JUMPN A,MTYIX1
ILDB A,MXCTPT
JUMPN A,@MTXDSP(A)
HRRZ A,@MXCTPT
TLO A,331100
MOVEM A,MXCTPT
JRST MTYIX
MTYIX1: EXCH A,(P)
POP P,@MACTMP
JRST MTYIX2
MTXDSP: ;PREVIOUSLY UNDEFINED
MESCPC: ;PREVIOUSLY UNDEFINED
MESCP: ;PREVIOUSLY UNDEFINED
>;MACDWP
;ZDATA ZSIX ZBLT ZEDFIL ZLIST EXIST ZSAVE ZFLDIR ZUNPAK
COMMENT ⊗
ZDATA is used to hold records of data extracted from EDFIL when a file change
requested. The format of EDFIL, and hence of each record in ZDATA is as follows:
Word Contents
-2 Number of lines per page in /F mode.
-1 Name of device in SIXBIT (DSK, UDP etc)
0 File name in SIXBIT
1 Extension in SIXBIT,,DATE INFORMATION
Bits 18-20 are the high order bits of the creation date
Bits 21-35 are used for the dump date.
2 Used by RENAME and ENTER
Bits 0-8 protection key
Byts 9-12 Mode field
Bits 13-23 time
Bits 24-35 low bits of the creation date
3 PPN in SIXBIT. This is overwritten in EDFIL by the LOOKUP routine.
4 Information that is in register D on entering BEG3 and put into SRCFIL
Contents are changed during course of deciphering file data
Location EDFIL in right half initially
Flag information kept initially in left half
Flags Meaning other→ F-Flag Word flag
100000 /N no directory
Has complete directory DIROK←←4
Editing directory EDDIR←←100
200000 /R readonly REDNLY←←1 RDONLY
400000 creating CREASW
If /N switch is found EDFIL location is moved to left half and
right half is set to 777777
5 CURPAG (binary),,ARRL (binary)
Additional information in ZDATA that is not in EDFIL
6 to =13 SPAGE,SLINE,,SPAGE,SLINE (2 XMARK values in each of 8 words)
=14 Serial referencing number stored at each reference to indicate usage order.
END OF COMMENT ⊗
IMPURE
ZNUM←←10 ;8 files.
;ZENT←←21 ;17 entries per file.
ZENT←←40 ;32 entries per file.
ZSIZE←←ZNUM*ZENT
0 ;Needed for /F mode line count.
0 ;Needed for initial device name
ZDATA: BLOCK ZSIZE-2 ;Space for file names and data
0 ;Not /F for QUERY (?) reference
SIXBIT /DSK/
SIXBIT /E/
SIXBIT /ALS/
0 ;to match EDFIL
SIXBIT / UPDOC/
0
2,,0 ;Default entry to page 2
BLOCK ZENT-4 ;Space for rest of QUERY (?) data
0
EZDATA←←.-2
ZINDEX: 0 ;Index to ZDATA as new name is typed.
ZOLDX: 0 ;Old INDEX saved for emergency return
ZOLDF: 0 ;Old flags saved
ZDATAR: 0 ;Return reference index to ZDATA
ZDATAN: 0 ;Back-up reference index
ZFLAGR: 0 ;Return flag condition
ZFLAGN: 0 ;Back-up flag condition
ZLISTC: 0 ;Referencing #, incremented for each file switching
PURE
ZSAVE: MOVE T,ZINDEX
MOVE TT,ARRL
HRL TT,CURPAG
MOVEM TT,ZDATA+5(T) ;The rest of the data was saved at FRD time
MOVE TT,EDFIL-2 ;except for this which may have been changed
MOVEM TT,ZDATA-2(T)
MOVE TT,EDFIL-1 ;This should not be necessary but try it anyway
MOVEM TT,ZDATA-1(T)
HRLI TT,MARKS
HRRI TT,ZDATA+6(T)
BLT TT,ZDATA+34(T) ;Now saving 23. marks in full words
;; TRNN F,REDNLY;now always save page
PUSHJ P,WRPAGE ;Write out page if needed
;; TRNE F,WRITE
;; PUSHJ P,ABCRLF
;; TRNE F,WRITE ;Did we flush some changes in a READONLY file?
;; OUTSTR [ASCIZ ⊗Warning: Text changes were not written out because of /R mode.
;;⊗]
PUSHJ P,CHKDEL ;See if the file should be deleted, and if so, do it
CLOSE DSKO, ;Make sure file gets out safely
MOVS TT,SYSCMD
CAIN TT,'CE ' ;If he said CETV (create), don't assume creating again
MOVEI TT,'ET '
MOVSM TT,SYSCMD ;Put back
PUSHJ P,FLSPAG ;This should flush page without bothering ATTACH buffer.
PUSHJ P,ZFLDIR ;Necessary to make room if repeated switching is allowed
SETZM DIRPT ;Directory has been fixed
SETZM DIRP1 ;Directory has been fixed
MOVEI TT,EDFIL+4
MOVEM TT,SRCFIL+4 ;To circumvent old monkey business
SETZM CREASW ;Don't want to be in CREATE mode for sure.
POPJ P,
ZUNPAK: HRLI TT,ZDATA+6(T)
HRRI TT,MARKS
BLT TT,MARKS+26 ;Unpack 23. marks
POPJ P,
;ZLIST is called by FRDX and stores data in the form required by BEG3.
;The new file data is first checked against the existing record, and if
;found in ZDATA the flag word ZDATAF is zeroed. If it is
;not found all data except the name is put in ZDATA at the first empty place
;and the name is put into a flag word ZDATAF. In either case ZINDEX is set.
;At BEG4 the name in EDFIL is checked against ZDATAF. If they match the name
;is written into ZDATA at the ZINDEX location. If they do not then nothing is
;done as the file data has already been saved.
ZLIST:
ESSAY,< SKIPE ESEPSY ;IF A π COMMAND, DO SOMETHING DIFFERENT
JRST ESZLST>
SKIPN QUERYF# ;Are we switching to E.ALS[UP,DOC]?
JRST .+3 ;No
SETZM QUERYF ;Yes, turn of indicator
POPJ P, ;and don't rewrite
MOVEI T,0
ZLIST1: MOVE TT,ZDATA(T)
JUMPE TT,ZLIST3 ;Empty space found, so not in list.
CAME TT,EDFIL ;Check file name
JRST ZLIST2 ;Not this file
MOVE TT,ZDATA-1(T)
CAME TT,EDFIL-1 ;Check device
JRST ZLIST2 ;Not the same device
HLLZ TT,EDFIL+1
HLLZ C,ZDATA+1(T)
CAME TT,C ;Check extension
JRST ZLIST2 ;Nope
MOVE TT,ZDATA+3(T) ;Check PPN
CAMN TT,EDFIL+3
JRST ZLIST3 ;Over+write data since some may be changed
ZLIST2: ADDI T,ZENT ;Go to next entry
CAIGE T,ZSIZE-1 ;but is there one?
JRST ZLIST1 ;Go back and try again
;Table is full, so find oldest referenced file (with smallest number)
MOVEI TT,ZSIZE-ZENT
MOVEI C,77777
CAMG C,ZDATA+ZENT-3(TT)
JRST .+3
MOVE T,TT ;Save index
MOVE C,ZDATA+ZENT-3(TT) ;and the lower value
SUBI TT,ZENT
JUMPGE TT,.-5
OUTSTR [ASCIZ /Reassigned referencing # /]
PUSH P,T
IDIVI T,ZENT
SETZM TYOPNT
TYPDEC T ;Report referencing number
POP P,T
OUTSTR [ASCIZ / to this file. /]
CAMN T,ATTFIL ;Reassigning index of original file for att buffer?
SETOM ATTFIL ;Yes, make sure we don't try to REPLACE att buffer
ZLIST3: MOVEM T,ZINDEX ;Save so CURPAG and ARRL can be added later.
AOS TT,ZLISTC ;Update reference order count
MOVEM TT,ZDATA+ZENT-3(T) ;and store
MOVNI TT,7 ;Transfer complete EDFIL (including /N in +4)
HRLZS TT ;device name in EDFIL-1 but not ERFIL-2
SETZM ZDATA-2(T) ;Final value not known at this time
ZLIST4: MOVE C,EDFIL-1(TT)
MOVEM C,ZDATA-1(T)
ADDI T,1
AOBJN TT,ZLIST4
MOVE T,ZINDEX
ZLIST5: POPJ P,
ESSAY,<
ESZLST: PUSH P,T ↔ PUSH P,TT ↔ PUSH P,C ;NORMAL ZLIST CODE WANTS THESE ALL ON STACK
SETZM ESEPSY
MOVE T,ZINDEX
ADDI T,ZENT
CAIGE T,ZSIZE-1 ;SKIP IF OVERSHOT TOP
JRST ZLIST3 ;THIS WILL SAVE NEW T AND MUMBLE ON
OUTSTR [ASCIZ /
Warning -- Ran out of file stack space. Clobbering last entry./]
SUBI T,ZENT
JRST ZLIST3
>;ESSAY
;This routine shows all files that have been assigned numbers with CURPAG and ARRL.
;If called with a 0 argument it deletes all marks instead
;It is called by the command <CONTROL>∃ or by <CONTROL>0<CONTROL>∃
EXIST: AOS (P) ;Always skip--don't say OK
TRNE F,ARG
SKIPE A ;Zero argument request to flush
JRST EXIST0 ;Reporting, not flushing
;Zero argument case for flushing
TRZ F,ARG ;Safety precaution only
SKIPN T,ZINDEX ;Get present file index
JRST EXISTA ;It is already at 0
;First move the present file record
MOVSI A,ZDATA-2(T)
ADDI A,ZDATA-2
BLT A,ZDATA-2+ZENT-1 ;Move current file listing to start at ZSDATA
;Now flush the rest
EXISTA: SETZM ZDATA-2+ZENT
MOVE T,[ZDATA-2+ZENT,,ZDATA-2+ZENT+1]
BLT T,ZDATA-2+ZSIZE-1
SETZM ZINDEX
SETZM ZDATAR
OUTSTR [ASCIZ /
Current file record shifted to 0, the rest have been flushed.
/]
POPJ P,
;No argument case for reporting
EXIST0: OUTSTR [ASCIZ /
/]
SETZM TYOPNT
EXISTF: MOVEI D,ZDATA
MOVEI E,0
EXIST1: MOVE TT,0(D)
JUMPE TT,CPOPJ
MOVE TT,E
IMULI TT,ZENT
CAME TT,ZDATAR
JRST .+3
TYPCHR "H"
SKIPA
TYPDEC E
CAME TT,ZINDEX
JRST EXIST3
TRNE F,REDNLY ;Are we in readonly mode?
TYPCHR "R" ;Yes, tell him
HRLZ A,CURPAG
HRR A,ARRL
MOVEM A,5(D) ;Put latest values inte ZDATA
TYPCHR "] " ;Mark current file differently for convenience
SKIPA
EXIST3: TYPCHR ") "
PUSHJ P,FILSTR ;Was FILST2
TYPCHR " "
HLRZ TT,5(D)
TYPDEC TT
TYPCHR "P"
HRRZ TT,5(D)
TYPDEC TT
TYPCHR "L "
ADDI D,ZENT
CAIL D,ZDATA+ZSIZE
JRST CPOPJ
CAIE E,3
AOJA E,EXIST1
SKIPN TYOPNT
PUSHJ P,CMDCRL ;Put out CRLF if past mid screen (Or TYOPNT≠0)
SKIPE TYOPNT
TYPCHR "
"
AOJA E,EXIST1
;To free the directory space. FLSDIR does not seem to work with Z routines
ZFLDIR: SKIPN A,DIR
POPJ P,
MOVE C,PAGES
TLO F,NOCHK
CAIN A,DIREND
JRST .+5
HRRZ B,(A)
PUSHJ P,FSGIVE
SKIPE A,B
SOJG C,.-5
TLZ F,NOCHK
TRZ F,DIROK ;We don't want to fool anybody
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
MOVEM T,DIROVH
SETZM DIR
POPJ P,
;LAMBDA EPSIL NWFILE HOME QUERY HOMEG LAMBDG EPSIL5 LAMEPS EPSIL2 EPSIL3 EPSIL4 EPSIL1
LAMEP3: OUTSTR [ASCIZ/ No such file entry. /]
SUB P,[1,,1]
JRST POPJ1
LAMEP4: PUSHJ P,DISP
XCT LINTST ;Update display unless whole line typed ahead
JRST LAMEP2
;Common routine for ε and λ.
LAMEPS: TRNN F,ARG
JRST LAMEP4 ;No number given (will read filename from tty)
JUMPL A,LAMEP3 ;No negative file numbers
CAILE A,ZNUM ;QUERY is now just beyond and is included
JRST LAMEP3 ;Illegal number
IMULI A,ZENT
SKIPN ZDATA(A) ;Check file name
JRST LAMEP3 ;No such file entry
LAMEP2: EXCH A,(P) ;Save index to get new file name etc.
PUSH P,A
PUSHJ P,ZSAVE ;Save a record of present conditions
MOVEM F,ZOLDF
POPJ P,
;LAMBDA (LOOK) opens a file in read-only mode but still allows one to enter or
;leave the file with text in the ATTACH buffer. Of course, attached text is not
;actually removed from the file unless one changes to read-write mode.
;It is called by the command <CONTROL>λ<FILE NAME> or if the file had been
;referenced earlier and assigned a number, say 2, by <CONTROL>2<CONTROL>λ
ESSAY,<
LAMBDG: SETOM ESEPSY ;MEANS WE GOT HERE BECAUSE OF αβπ COMMAND, DO DIFFRNT STUFF
SETZM ESCTLM
TRNN B,2
JRST EPSIL ;FOR CONTROL PI, ASK FOR FILE NAME, ETC. BUT DO ESEPSY PUSHJ
NOESS,< POPJ P, ;IGNORE αβπ UNLESS IN ESSAY>
SETOM ESCTLM ;FOR CONTROL META PI SET FLAG, DO READONLY
>
LAMBDA: PUSHJ P,LAMEPS ;Check validity of arg and do common ε and λ stuff
TRO F,REDNLY ;Set for read only
SETOM RDONLY ;Set for read only
JRST EPSIL0
;EPSILON (ENTER) opens a file in read-write mode.
;It conforms in other respects to LAMBDA above.
EPSIL: PUSHJ P,LAMEPS ;Check validity of arg and do common ε and λ stuff
TRZ F,REDNLY ;Set for READWRITE
SETZM RDONLY ;Set for read write
EPSIL0: SETOM ZATT# ;We have now switched files--preserve ATTACH buffer
SETZM QUIETF# ;Don't assume this for new file
SETZM BOOKSW# ; nor BOOK mode
MOVE T,ZINDEX
MOVEM T,ZOLDX
MOVE TT,ZOLDF
CAIN T,ZNUM*ZENT ;Is this the ? file?
JRST [MOVE T,ZDATAN↔MOVE TT,ZFLAGN↔JRST .+1] ;yes
EXCH T,ZDATAR
MOVEM T,ZDATAN
EXCH TT,ZFLAGR
MOVEM TT,ZFLAGN
SETZM DIR ;So that new directory will be created.
POP P,T ;Get new ZINDEX which was set up by LAMEPS
TRNN F,ARG
JRST EPSIL2
MOVEM T,ZINDEX ;Save as index to get new file name etc.
EPSIL1: MOVE A,ZDATA(T) ;Get file name
JUMPN A,EPSIL3
EPSIL4: ESSAY,<SKIPN ESEPSY ;GIVE DIFFERENT MESSAGE FOR αβπ COMMAND>
OUTSTR [ASCIZ / Request aborted.
/]
ESSAY,<SKIPE ESEPSY ;FOR αβπ USER, SAY
OUTSTR [ASCIZ / No suitable file pointer found.
/]
>;ESSAY
PUSHJ P,MACSTP ;Terminate macro expansion.
SETZM RDONLY ;restore read status
MOVE F,ZOLDF
TRNE F,REDNLY
SETOM RDONLY
MOVE T,ZOLDX
MOVEM T,ZINDEX
CAME T,ZDATAR
JRST EPSIL1 ;We came from QUERY so we are through
MOVE TT,ZDATAN ;Restore old HOME designation
MOVEM TT,ZDATAR
MOVE TT,ZFLAGN
MOVEM TT,ZFLAGR
JRST EPSIL1
EPSIL3: MOVEM A,EDFIL
SETZ A,
TRNE F,REDNLY ;If switching in READWRITE mode, don't want /F flag.
MOVE A,ZDATA-2(T) ;Get /F mode line count
HRRZM A,EDFIL-2
MOVE A,ZDATA-1(T) ;Get device name
MOVEM A,EDFIL-1
HLLZ A,ZDATA+1(T) ;Get extension
MOVEM A,EDFIL+1
SETZM EDFIL+2
MOVE A,ZDATA+3(T) ;Get PPN
MOVEM A,EDFIL+3
SETZ D,
TRNN F,REDNLY ;If in /READW mode and formerly /F, clear /N
SKIPN ZDATA-2(T) ;Test old /F flag
MOVE D,ZDATA+4(T)
MOVEM D,EDFIL+4
HLRZ B,ZDATA+5(T) ;Get CURPAG
MOVEM B,CURPAG
MOVEM B,SPAGE
HRRZ B,ZDATA+5(T) ;Get ARRL
MOVEM B,ARRL
MOVEM B,SLINE
PUSHJ P,ZUNPAK ;Unpack the line MARKS
MOVEI C,15 ;BEG3 MAY EXPECT THIS
POP P,T ;Get rid of last return address
ANDI F,REDNLY!ATTMOD ;The only flags to be saved.
MOVE T,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM T,SRCFIL-EDFIL(T)
HRRZM T,DSTFIL-EDFIL(T)
AOBJN T,.-2
MOVSI T,FRDNAM!FRDEXT!FRDPRJ!FRDPRG!FRDDEV
HLLM T,SRCFIL ;Note that we have entire explicit filename
JRST BEG3
EPSIL2: ;GET HERE WHEN ε OR λ GETS NO ARG, ASK FOR FILE NAME
POP P,T ;Get rid of last return address
SETZM SLINE
SETZM SPAGE
SETZM XXPAGE
SETZM XXLINE
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
SKIPN ESEPSY ;SKIP IF αβπ COMMAND
JRST EPSIL5 ;NOPE, DO NORMAL αβε OR αβλ THING
SKIPN ESCTLM ;SKIP IF CONTROL META π; CTRLπ MEANS DON'T SCAN FILE FOR PTR
JRST EPSIL5
PUSHJ P,PTRP ;RETURN POINTER TO LINE IN A, DIRECT IF PTRBIT IS ON
JRST ESSREA ;READ LINE, GO TO FILE
JRST ESSREA ;GO THERE IN ANY CASE, WE NOT USING PTRBIT ANYMORE
;< >;ESSAY
;This starts new file OK, takes ATTACH buffer along but required a
;special flag to inhibit losing the the attachment.
EPSIL5: SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]]
;Give him back control-cr feature and undo ALLACT
PUSHJ P,ABCRLF
PUSHJ P,LOADMT ;So that ALLACT won't affect filename line type-ahead
OUTSTR [ASCIZ /File? /] ;LOADMT skips if expanding a macro.
SETZM TYIPNT ;Make FRD read filename from TTY.
MOVEI D,EDFIL ;Make FRD put filename at EDFIL.
MOVE A,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
JRST BEGSY2 ;Now we go process new filename.
;NWFILE: OUTSTR [ASCIZ \
; XNWFILE has been replaced by the ε and λ commands. See E.ALS[UP,DOC]/11P
; You can switch to this now by typing <CONTROL>? and get back by <CONTROL>H
;\]
; JRST POPJ1C
;The H (HOME) command allows one to return to the last previous file
;which is presumed to be the home file.
HOMEF: MOVE T,ZDATAR ;Get return index value
CAME T,ZINDEX ;Are we already home
JRST HOMEF1
SORRY You are already HOME!
JRST POPJ1
HOMEF1: PUSH P,A
PUSHJ P,ZSAVE ;Save a record of present conditions
POP P,A
MOVEM F,ZOLDF
MOVE T,ZINDEX
MOVEM T,ZOLDX
MOVE TT,F
CAIN T,ZNUM*ZENT
JRST [MOVE T,ZDATAN↔MOVE TT,ZFLAGN↔JRST .+1]
EXCH T,ZDATAR
MOVEM T,ZINDEX
TRNN F,ARG!REL ;Was an argument or sign typed?
JRST HOMEF3 ;No
TRNN F,REL ;Was a sign used?
JRST HOMEF2 ;No
HLRZ C,ZDATA+5(T) ;Get former page reference
ADD A,C
SKIPG A
MOVEI A,1 ;Go to directory page in this case
HOMEF2: HRLZM A,ZDATA+5(T) ;Set specified page
AOS ZDATA+5(T) ;Set to line 1
HOMEF3: EXCH TT,ZFLAGR
TRNN TT,REDNLY
JRST .+4
TRO F,REDNLY
SETOM RDONLY
JRST EPSIL1
TRZ F,REDNLY
SETZM RDONLY
JRST EPSIL1
ESSAY,<
HOMEG: PUSH P,A ;SAVE THE ARG OVER THIS RANDOM CALL
PUSHJ P,ZSAVE ;SAVE A RECORD OF PRESENT STATE
POP P,T
MOVEM F,ZOLDF
TRNN F,ARG ;IF WE GOT NO ARG
SKIPA T,[-ZENT] ;GO BACK 1 FILE IF NO ARG
IMUL T,[-ZENT]
ADD T,ZINDEX
CAIGE T, ;IF NEG, USR REALLY MEANT ZERO [BACKED OFF TO FAR
MOVEI T, ;THIS IS FOR YOUR OWN GOOD.
MOVEM T,ZINDEX ;SAVE NEW ZINDEX (FILE SHOULD LOOK AT)
JRST EPSIL1
>
;QUERY allows you to reference the file E.ALS[UP,DOC] to check on some feature
;without losing your place in the file being edited. You gets back home by the H
;command. On a second call, QUERY now remembers where you were and returns there.
;QUERY will accept an argument specifying a desired page or a signed argument to
;specify a relative change from the previous page specification.
QUERY: MOVE T,ZINDEX
CAIN T,ZNUM*ZENT ;Are we already in E.ALS[UP,DOC]?
JRST QUERY2 ;Yes
TRNN F,ARG!REL ;Was an argument or sign typed
JRST QUERY3 ;No
TRNN F,REL ;Was a sign used?
JRST QUERY4 ;No
HLRZ C,ZDATA+5+ZNUM*ZENT ;Get former page reference
ADD A,C
SKIPG A
MOVEI A,1 ;Go to directory page in this case
QUERY4: HRLZM A,ZDATA+5+ZNUM*ZENT ;Set specified page
AOS ZDATA+5+ZNUM*ZENT ;Set to line 1
QUERY3: MOVEI A,ZNUM ;Data is just beyond the other ZDATA
TRO F,ARG ;Pretend that there was an argument of ZNUM
SETOM QUERYF ;Set flag to prevent storing at ZLIST time
JRST LAMBDA
QUERY2: SORRY <You are already in E.ALS[UP,DOC]!>
JRST POPJ1
;********* BEG OF ESSAY DEFS *********
;ESSAY,<
DEFINE FOO (MSG) <
PUSHJ P,[
PUSH P,T
FOR ZZZ ε <MSG> <
IFN 12-"ZZZ",< ;FILTER OUT LFS
MOVEI T,"ZZZ"
IDPB T,ESILBP
>;IFN LINE FEED
>;FOR
POP P,T
POPJ P,
];PUSHJ
>;DEFINE FOO
DEFINE FOOC (MSG) <
PUSHJ P,[
PUSH P,T
FOR ZZZ ε <MSG> <
IFN 12-"ZZZ",< ;FILTER OUT LINE FEEDS
MOVEI T,"ZZZ"
IORI T,200
IDPB T,ESILBP
>;IFN LINE FEED
>;FOR
POP P,T
POPJ P,
];PUSHJ
>;DEFINE FOO
ESCOMT: MOVE T,[441100,,ESCMTX] ;POINTER TO AREA FOR COMMAND STRING TO BE PTWRS9d
MOVEM T,ESILBP
OUTSTR [ASCIZ /Moment please.../]
MOVEI T,615 ;<CTRL><META><RETURN>
IDPB T,ESILBP
FOO <(Comment here by >
GETPPN T,
LDB TT,[140600,,T] ;PICK UP THE FIRST CHARACTER OF PROGRAMMER NAME
CAIN TT, ;THERE ARE STILL A FEW BAG BITERS W 2 CHR PROGRAMMER NAMES
JRST ESCM1
ADDI TT,40
IDPB TT,ESILBP
ESCM1: LDB TT,[60600,,T] ;SECOND CHR
ADDI TT,40
IDPB TT,ESILBP
ANDI T,77 ;AND NOW FOR SOMETHING COMPLETELY DIFFERENT
ADDI T,40
IDPB T,ESILBP
FOO < is on page >
MOVE T,PAGES ;GET PAGE NUMBER OF LAST PAGE
ADDI T,1
PUSHJ P,ESDPT ;DECIMAL PRINT TO ESILBP
FOO <.)>
MOVEI T,215
IDPB T,ESILBP
FOOC <π> ;CONTROL RETURN AT END OF NEW COMMENT POINTER AND CTRL π FOR COMMENT PAGE PUSHJ
MOVE T,[440600,,EDFIL]
REPEAT 6,<ILDB TT,T ;CRANK OUT OUR FILE NAME
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
MOVEI TT,"."
IDPB TT,ESILBP
REPEAT 3,<ILDB TT,T ;EXT
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
MOVEI T,"[" ;PPN
IDPB T,ESILBP
MOVE T,[440600,,EDFIL+3]
REPEAT 3,<ILDB TT,T
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
MOVEI TT,","
IDPB TT,ESILBP
REPEAT 3,<ILDB TT,T
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
FOO <](>
MOVE T,PAGES ;AND LAST PAGE NUMBER OF FILE
PUSHJ P,ESDPT
FOO <P)>
MOVEI T,15
IDPB T,ESILBP
FOOC <∞WX>
FOO <M>
MOVEI T,15 ↔ IDPB T,ESILBP
FOOC <V>
SKIPE ESCMTZ ;WORD AFTER ESCMTX BLOCK. SHOULD NOT HAVE BEEN WRITTEN INTO
FATAL Bug 69 in Essay comment code.
PUSHJ P,READWR ;WANT TO BE IN READW MODE
DPYPOS -1020 ;POSITION OFF THE SCREEN SO USER DOESNT HAVE TO SEE TRASH
MOVEI T, ;OUTPUT NULL SO PTW WILL KNOW WHERE TO STOP
IDPB T,ESILBP
;ESGK: PUSHJ P,ESDBG ;DEBUG FEATURE
DPYPOS -1500 ;OFF END SO USER DONT HAVE TO SEE WHAT GOING ON
PTWRS9 [0↔ESCMTX]
SETOM ESCGIS# ;SET FLAG TO GET αβV COMMAND TO TYPE INSTRUCTIONS FOR USER
AOS (P)
POPJ P,
COMMENT ⊗
ESDBG: MOVE T,[441100,,ESCMTX]
DPYSIZ 30001
DPYPOS 1
ESDBG1: ILDB TT,T ;GET 9 BIT BYTE
JUMPE TT,[INCHRW TT ↔ POPJ P,]
TRZE TT,200 ;CONTROL BIT?
OUTSTR [ASCIZ /<CTRL>/]
TRZE TT,400 ;META BIT?
OUTSTR [ASCIZ /<META>/]
CAIN TT,15 ;CR
JRST [OUTSTR [ASCIZ /<CR>/] ↔ JRST ESDBG1]
CAIN TT,12 ;LF
JRST [OUTSTR [ASCIZ /<LF>/] ↔ JRST ESDBG1]
CAIN TT,11
JRST [OUTSTR [ASCIZ /<TAB>/] ↔ JRST ESDBG1]
OUTCHR TT
JRST ESDBG1
⊗;COMMENT
ESDPT: PUSH P,T
PUSH P,TT
PUSHJ P,ESDPT1
POP P,TT
POP P,T
POPJ P,
ESDPT1: IDIVI T,=10
HRLM TT,(P)
SKIPE T
PUSHJ P,ESDPT1
LDB TT,[220600,,(P)]
TRC TT,=48
IDPB TT,ESILBP
POPJ P,
ESINIT: ;INIT ESSAY VARS, ETC.
PUSHJ P,READONLY ;DEFAULT TO READONLY ALWAYS IN ESSAY. LATER THIS
;WILL HAVE TO CHECK THE STARTUP AND ESSAY SWITCH
POPJ P,
ESSREA: ;LOOK FOR A FILE NAME IN THE NEXT LINES OF TEXT, AND GO TO IT
MOVEI D,.ILDB ;INITIALIZE JSP AC FOR READING TEXT
MOVEM A,ESSBOS ;SAVE PTR TO CURRENT LINE FOR LOOKING FOR
ESRE1: JSP D,(D) ;PICK UP A CHR FROM LINE
JRST ESREFF ;END OF PAGE, FAILED TO FIND A SUITABLE FILE
CAIE A,"[" ;WE ARE LOOKING FOR WHAT COULD BE MIDDLE OF FILE NAME
JRST ESRE1 ;LOSE, TRY AGAIN
MOVEI B,"," ;SKIP RETURN IF THERE ARE 1-3 A-Z,a-z,0-9 CHARACTERS IN A
PUSHJ P,ESR3CH ;ROW, BROKEN WITH A COMMA
JRST ESRE1 ;LOSE, THIS GUY DOESN'T QUALIFY AS A PPN
MOVEI B,"]" ;SKIP RETURN IF YOU FIND ANOTHER 1-3 BROKEN BY CLOSE SQUARE
PUSHJ P,ESR3CH ;THE OTHER 1-3?
JRST ESRE1 ;CLOSE CALL...
PUSHJ P,ESBAKB ;BACK OVER THE FILE NAME
PUSHJ P,ESREC ;GIVE THIS FILE NAME ETC. TO TTY
FATAL <Internal confusion. Can't understand pointer>
PUSHJ P,RSCAN ;MAKE EVERYTHING READY FOR READING INSERTED FILE NAME
JRST BEG1 ;AND DON'T ASK FOR FILE NAME ON P OF PAPER
ESCCR: ;GOT A '(Comment h' at beg of line. COMMENT POINTER
CAIE A,"(" ;DOUBLE CHECK
FATAL INTERNAL CONFUSION -- COMMENT POINTER WENT AWAY
FOR ZZZ ε <Comment here by ∀∀∀ is on page > <
JSP D,(D) ;GET THE CHARACTER
FATAL PREMATURE END OF COMMENT POINTER
IFN "ZZZ"-"∀",< ;CHECK THE CHARACTER AGAINST STRING EXCEPT FOR ∀'S
CAIE A,"ZZZ"
FATAL CONFUSION WHILE READING COMMENT POINTER. PLEASE REPORT TO SGK
>;IFN
>;FOR
MOVEI T,
ESCCR1: ;Have just found reasonable comment pointer. Read a page number terminated
;by a period.
JSP D,(D) ;GET A CHARACTER
FATAL PREMATURE END OF COMMENT POINTER LINE WHILE READING PAGE NUMBER.
CAIN A,"." ;PERIOD MEANS END OF PAGE NUMBER
JRST ESCCR2 ;NOW GO THERE
IMULI T,=10
ADDI T,-"0"(A)
JRST ESCCR1
ESCCR2: MOVEM T,ESCCRT# ;HOLD ONTO PAGE NUMBER TO BE USED
MOVE T,[441100,,ESCMTX] ;SET UP BYTE POINTER FOR FILE SWITCHING COMMAND
MOVEM T,ESILBP
MOVE T,[440600,,EDFIL]
REPEAT 6,<;CRANK OUT OUR F FILE NAME
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <.> ;PUNCTUATION BETWEEN FIRST FILE NAME AND EXT
REPEAT 3,<;CRANK OUT OUR EXT
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <[> ;BEGIN PPN
MOVE T,[440600,,EDFIL+3]
REPEAT 3,<;CRANK OUT F HALF OF PPN
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <,>
REPEAT 3,<;CRANK OUT 2 HALF OF PPN
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <](> ;CLOSE PPN, BEGIN SWITCHS (FOR PAGE NUMBER)
MOVE T,ESCCRT ;GET PAGE NUMBER
PUSHJ P,ESDPT
FOO <P)
>; IS "(69P)"<CR>
MOVEI T, ;OUTPUT NULL SO PTW WILL KNOW WHERE TO STOP
IDPB T,ESILBP
PTJOBX [0↔3]
PTWRS9 [0↔ESCMTX]
PTJOBX [0↔4]
PUSHJ P,RSCAN
JRST BEG1
PURGE FOO,FOOC
ESBAKB: ;BACK UP OVER THE FILE NAME
MOVE A,ESILBP ;GET THE BYTE POINTER WE WILL BE BACKING UP
ESBKB1: ADD A,[70000,,] ;GO ON TO THE PREVIOUS BYTE
CAIG A, ;DIRECT IF WE ARE READY TO MOVE ON TO PREVIOUS WORD
SUB A,[430000,,1];MAKE IT 010700,,<PREVIOUS WORD TO ONE WE WERE READING FROM>
CAMN A,ESOLBP ;DIRECT IF WE HAVE BACKED THE BYPE POINTER INTO BEGINING OF THIS LINE
;ESOLBP HAS THE BYTE POINTER FOR BEG OF LINE AS CONSd UP BY .ILDB
JRST ESBKBE ;WE MUST BE THERE
LDB B,A ;GET THE CHARACTER
CAIE B," " ;SPACE
CAIN B,11 ;TAB
JRST ESBKBE ;BREAK ON
JRST ESBKB1 ;SOME MORE
ESBKBE: MOVEM A,ESILBP ;SAVE THIS AS CURRENT BYTE POITER
POPJ P,
ESREFF: JRST EPSIL4 ;FOR NOW ;COULDN'T FIND A FILE NAME ON THIS PAGE
ESR3CH: ;SKIP RETURN IF THERE ARE 1 THRU 3 CHRS A-Z,a-z 0-9 STRAIGHT BROKEN BY (B)
REPEAT 3,<
JSP D,(D) ;CHR
POPJ P,
CAIN A,(B) ;THE ONLY WEIRD CHARACTER ALLOWED, CALLER SUPPLIED
JRST ESR3C1 ;DUN
CAIGE A,"0" ;IF YOU ARE BEHIND 0 YOU LOSE FOR SURE
POPJ P,
CAIL A,":" ;IF BETWEEN : AND @ YOU LOSE
CAILE A,"@"
CAIA ;CHARACTER WINS
POPJ P, ;CHARACTER LOSES
CAIL A,"[" ;IF BETWEEN [ AND ` YOU LOSE
CAILE A,"a"-1;NOT SURE OF KEYBOARD CHR JUST BEFORE a
CAIA
POPJ P,
CAILE A,"z" ;DIRECT IF AFTER z.
POPJ P,
>;REPEAT 3
JSP D,(D) ;NOW THAT WE HAVE HAD 3 REAL CHRS, MUST FIND A 'WEIRD' CHR
POPJ P, ;NO MORE PAGE
CAIE A,(B)
POPJ P,
ESR3C1: AOS (P) ;IF YOU GOT THIS FAR YOU DESERVE TO SKIP
POPJ P,
.ILDB: PUSH P,B ↔ PUSH P,C
MOVE A,ESSBOS ;GET THE PTR TO VERY LINE USER POINTING AT, IS 1ST
MOVEM A,ESILBS ;PTR TO THE BEG OF LINE TO READ FROM
.ILDB0: MOVE A,ESILBS ;GET ADDRESS OF FIRST WORD OF LINE'S BLOCK
HLRZ B,TXTCNT(A)
MOVEM B,ESILRC ;SOSGE COUNTER OF N CHRS FOLLOWING BYTE PTR GOOD FOR
ADD A,[10700,,2] ;FOURTH WORD OF BLOCK IS TEXT, MAKE A BYTE PTR OF ADDRS
MOVEM A,ESILBP
MOVEM A,ESOLBP ;THIS ONLY GETS CLOBBERED HERE. SO ESBAKB KNOWS WHERE BEG OF LINE IS
MOVE B,1(A) ↔ CAMN B,["(Comm"⊗1+1] ↔ JRST [MOVE B,2(A) ↔ CAMN B,["ent h"⊗1+1]
MOVEI D,ESCCR-1 ↔ JRST .+1 ]
.ILDB1: SOSGE ESILRC ;SKIP IF THERE ARE ANY CHRS LEFT TO READ HERE
JRST .ILD1 ;THIS LINE RAN OUT, GO GET A NEW ONE
ILDB A,ESILBP
POP P,C ↔ POP P,B
JSP D,1(D) ;SKIP RETURN
PUSH P,B ↔ PUSH P,C
JRST .ILDB1 ;WHEN HE ASKES FOR NEXT CHR, GO THRU THIS AGAIN
.ILD1: ;CHRS IN THIS LINE RAN OUT, CHECK OUT NEXT LINE
MOVE A,ESILBS ;GET THE ADDRESS OF LINE THAT JUST EXPIRED
HRRZ A,(A) ;GET SECOND WORD OF THIS BLOCK, WHICH PTS TO NEXT
CAIN A,BOTSTR ;IF IT POINTS TO BOTSTR, NO MORE LINES IN PAGE
JRST .ILDNC ;NO MORE CHARACTERS, DIRECT RETURN. SUBSEQUENT CALLS DIRECT RETURN
MOVEM A,ESILBS ;SAVE POINTER TO THIS NEW LINE
MOVE B,(A) ;NOW GET FIRST WORD OF NEW LINE TO SEE IF IT IS COMMENT
CAMN B,["(Comm"⊗1+1]
JRST [ MOVE B,1(A) ;WIN. SEE IF NEXT WORD MAKES IT TOO
CAMN B,["ent h"⊗1+1]
MOVEI D,ESCCR+1 ;MUNG THIS SO WE WILL RETURN TO COMMENT HACKER
JRST .+1 ;OH WELL
]
JRST .ILDB0 ;NOW MAKE UP BYTE POINTER, CHARACTER COUNT, AND DO IT
.ILDNC: POP P,C
POP P,B
JSP D,(D) ;DIRECT RETURN INDICATING NO MORE CHARACTERS
JRST .-1 ;FOR SUBSEQUENT CALLS UNTIL .ILDB SUBR RESET.
;ALLOWS END OF PAGE INFORAMATION TO PROPAGATE UP PDL, SORT OF
IMPURE
ESEPSY: 0 ;ZERO EXCEPT WHEN EPSIL STUFF IS DOING AN ESSAY STYLE HACK
ESCTLM: 0 ;-1 WHEN CTL META π, 0 FOR CTL π MEANING
;SERACH FOR TEXT PTR, AND ONLY READ KEYBOARD RESPECTIVELY
ESILRC: 0 ;.ILDB KEEPS # CHRS LEFT IN THIS LINE HERE
ESILBP: 0 ;KEEP BYTE PTR HERE WHILE IN A LINE, COMMENT CODE ALSO USES
ESOLBP: 0 ;PUT EACH NEWLY CONSd UP ESILBP HERE FOR ESBAKB
ESILBS: 0 ;POINTER TO LINE .ILDB IS READ HERE
ESCMTX: BLOCK =40 ;HOLDS COMMAND STRING TO BE PUT IN INPUT BUFFER
;FOR COMMENT (αβ∀) COMMAND
ESCMTZ: 0 ;IF THIS IS NON 0 SOMETHING IS WRONG
PURE
ESREC: ;COPY TO TTY FROM ESILBP. DIRECT RETURN ON NULL, SKIP RETURN ON
;SPACE OR CR. APPEND CR FOR SPACE OR CR. AFTER ] IS SEEN, FILTER . AND ,
PUSH P,A ↔ PUSH P,B ↔ PUSH P,C
MOVEI A,
MOVEI B, ;ZERO LINE NUMBER IS US
ESRE1A: ILDB C,ESILBP ;GET A CHARACTER
JUMPE C,ESRE1B ;SKIP RETURN ON NULL
TRNN A,1 ;SKIP IF A ] HAS BEEN PROCESSED
JRST ESRE1C ;CONTINUE IN NORMAL MODE
CAIE C,"." ;REMOVE THESE AFTER A ] HAS BEEN SEEN
CAIN C,"," ;E.G. "... IN FOO.BAR[105,SGK]/69P, OR ABC.DOC[UP,DOC]."
JRST ESRE1A ;JUST INGORE THESE CHARACTERS
ESRE1C: CAIN C,"]" ;AFTER THIS HAS BEEN SEEN, FILTER OUT , AND .'S
TRO A,1 ;FLAG
CAIE C,15 ;SKIP RETURN ON CR OR SPACE DELIMTER. SEND CR BEFORE RETURN
CAIN C," "
JRST ESRE1B
PTWR1S B ;SEND THE CHARACTER
FATAL <Bug 69 in Essay code>
JRST ESRE1A ;MORE
ESRE1B: MOVEI C,15 ;SEND A CR
PTWR1S B
FATAL <Bug 69 in Essay code>
AOS -3(P) ;SKIP RETURN
CPOPJ3: POP P,C
POP P,B
POP P,A
POPJ P,
PTRP: ;SKIP RETURN IF PTRBIT IS OFF FOR ARRL, ALWAYS RETURN ADDRESS OF BLOCK IN A
MOVEI A,PAGE ;INITIALIZE LOOP RUNNING THRU LINES FOR ARRL
MOVE T,ARRL ;LOOP COUNT, WANT ARRL LINE'S BITS
PTRP1: HRRZ A,(A) ;GET POINTER TO NEXT LINE RECORD FROM SECOND WORD
SOJG T,PTRP1 ;LOOP COUNT
;A NOW POINTS AT THE CURRENT LINE
MOVE T,2(A) ;GET THE BITS FROM THIRD WORD OF BLOCK
TLNN T,PTRBIT ;SKIP IF THIS IS A REFERENCE LINE
AOS (P) ;SKIP RETURN, NOT A REFERENCE
POPJ P,
IMPURE
ESSBOS: 0 ;PTR TO CURRENT LINE GET STUCK HERE WHEN LOOKING FOR FILENAME
ESARRL: 0 ;GETS POINTER TO LINE REFERENCE FOUND IN
PURE
;>;IFN ESSAY
;SUBSTR SUBST0 SUBST1 SUBST4 SUBST5 QFAST1 QFAST5 SUBSAY SUBOVE QFAST6 QFAST8 QFAST9
SUBSTR: MOVEI A,1
MOVEM A,JCNT ;Probably not needed
MOVE D,ARRLIN
HRRZM D,JPTR# ;Location of source line of text in JPTR.
HLRZ A,(D) ;Left half of (D) into right half of A
HRLZM A,JLPT# ; and then into left half of JLPT.
MOVE E,SAVEE ;This may have been changed
SETZB B,G
MOVE A,ARRLIN ;Set by SETARR to line for action
SUBST0: MOVE D,TXTFLG(A) ;Was MOVE D,1(A)
MOVEM D,SUBTMP# ;Save flags
ADD A,[440700,,LLDESC] ;Location where text starts
MOVE D,[440700,,BUF]
MOVEM D,JWPT ;Buffer pointer at start
MOVEI Q,SUBBUF(E) ;Substitution text location
ADD Q,[440700,,0]
SETOM BUF
MOVE T,[BUF,,BUF+1]
BLT T,BUF+37 ;Set up buffer properly
MOVE B,[-167,,0] ;Allow one space less than Line-Buffer size
HRRE T,SRCOFF ;Character position to start deletion
JUMPLE T,SUBST1 ;Substitution starts with the first character
ILDB C,A
IDPB C,D ;Copy text to deletion point
CAIN C,11
PUSHJ P,SUBTAB ;We must do this to get G and B set right
AOBJP B,.+1 ;Do not warn of overflow yet
SOJG T,.-5
SUBST1: HLRZ T,SUBSIZ(E) ;Get count of text to delete
ILDB C,A ;Index over replaced text
CAIN C,11 ;TABs require special treatment
PUSHJ P,EATTAB
SOJG T,.-3 ;Count deletions
HRRZ T,SUBSIZ(E) ;Length of substitution string is here
JUMPE T,SUBST3 ;The null substitution case
SUBST2: ILDB C,Q
IDPB C,D
CAIN C,11
PUSHJ P,FIXTAB ;Must fix TAB representation
AOBJP B,SUBOV1 ;Now warn that substitution itself is beyond buffer
SOJG T,SUBST2 ;Count insertions
SUBST3: ILDB C,A ;Get rest of original text
CAIN C,15 ;Watch for the CR
JRST SUBST4
IDPB C,D
CAIN C,11
PUSHJ P,SUBTAB ;Again do proper thing for TABs
AOBJN B,SUBST3
JRST SUBST3 ;Go on anyway, test comes later
EATTAB: ILDB C,A ;Eat all blanks to the next TAB
CAIE C,11
JRST .-2
POPJ P,
;This routine eats old spaces associated with tabs and puts in the correct number.
;It also keeps the correct records in G and B.
SUBTAB: ILDB C,A
CAIE C,11 ;First eat all old spaces
JRST .-2
FIXTAB: ADDI G,(B)
HRLI B,(B)
TLO B,-10
MOVEI TT,40
IDPB TT,D ;Insert correct number of spaces
AOBJN B,.-1
SUBI G,-1(B)
IDPB C,D ;Deposit terminating TAB
HRLI B,(B)
ADD B,[-167,,0] ;Restore safe count in left half
AOS (P) ;Skip return as we have already updated B enough
POPJ P,
;We have come to the end of the line
SUBST4: HRRZ T,B ;Are there be any chars left?
JUMPN T,SUBST5 ;Yes
MOVEI T,40 ;Need at least 1 char
IDPB T,D
TLO F,NULLIN ;No text in this line
SUBST5: IDPB C,D ;Now the CR
MOVEI C,12
IDPB C,D
TDZA C,C ;Set C to zero and skip
IDPB C,D
TLNE D,760000
JRST .-2 ;Pad out with nulls
JUMPLE B,QFAST1
SUBOVE: SETZM TYOPNT
PUSHJ P,ABCRL0 ;Type CRLF, preserving T.
OUTSTR [ASCIZ /Line /]
TYPDEC ARRL
OUTSTR [ASCIZ / on page /]
TYPDEC CURPAG
OUTSTR [ASCIZ / is too long for the LINE-EDITOR buffer.
Do you want to make substitution anyway? (type Y or N) /]
PUSHJ P,YESCHK
JRST QFAST1 ;Go ahead
JRST SUBOV3
;Now we must give up the space originally used by the line
QFAST1: MOVE A,JPTR ;Location of line
HLRZ T,TXTCNT(A)
MOVNI T,(T) ;and do 1's complement of T
ADDM T,CHARS ;add this to # in CHARS or ATTSIZ.
HRRZ C,(A) ;Get line forward pointer
MOVEM C,JPTR ;and put it in JPTR.
MOVSI T,JPTR ;with JPTR location in left half
HLLM T,(C) ;of pointer for line pointed to.
TLO F,NOCHK ;Save us from screwage! 9/25/75--ME
PUSHJ P,FSGIVE ;Give up storage space.
TLZ F,NOCHK ;Back to normal.
;Then we create a new line with proper pointers
ADDI G,2(B) ;Allow for CR and LF in G count
ADDM G,CHARS ;Previously debited by the number in original line
HRLZS G
IORI G,(B)
MOVEI B,-BUF+1+LLDESC(D) ;Number of words.
PUSHJ P,FSGET ;Get space to store line.
MOVSI TT,BUF ;Starting location of source
HRRI TT,LLDESC(A) ;and starting location of destination.
BLT TT,-2(T) ;and now BLT, ending at location -2(T)
MOVSI T,TXTCOD ;A fancy way to store 2 in left half!
HLLM T,-1(A)
MOVE T,SUBTMP
HLLM T,TXTFLG(A) ;Was HLLZM T,1(A) ;Replace old flags in left half
MOVEM G,TXTCNT(A)
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
HLRZ T,JLPT
JFCL
CAIE T,PAGE
SKIPGE TXTFLG(T) ;Was SKIPGE 1(T)
TRO F,UPDTXT ;Flag change in first line.
JFCL
QFAST8: TRO F,WRITE
HRLM T,(A)
HRRM A,(T)
MOVE TT,ARRLIN
CAMN TT,WINLIN
HRRZM A,WINLIN
HRRZM A,ARRLIN
HRLM A,(C)
HRRM C,(A)
HRRZ TT,TXTSER(A) ;Was HRRZ TT,2(A)
MOVEM TT,SRCNUM ;This will have been changed
QFAST6: PUSHJ P,SETWRT ;May need attention
HRRZ TT,SUBSIZ(E)
ADD TT,SRCOFF
SUBI TT,1
; SKIPGE TT
; SETZ TT,
; HRLI TT,1
HRRZM TT,SRCOFF ;Move to last character of substitution
;Update count and test for continuance
MOVE TT,QCHR
AOBJP TT,QFAST4
MOVEM TT,QCHR
MOVEM TT,SUBFLG(E)
QFAST7: TRZ F,ARG!REL
TLZ F,OKF
CAIN E,FNDBUF
JRST FINBSL ;Go to the X routine
CAIN E,FNDTBF
JRST FNDBSL ;Go to the page-only routine
OUTSTR [ASCIZ /
Report bug to ALS/]
JRST SUBERR
QFAST4: JUMPE TT,QFAST5
QFAST9: PUSHJ P,ABCRL0 ;Type CRLF, preserving ACs
OUTSTR [ASCIZ /As requested, /]
AOS SUBFLG(E)
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSTP ;To report on actual number replaced
QFAST5: SETZM QCHR ;Have done 1 substitution
SUBSAY: PUSHJ P,ABCRL0 ;Type CRLF preserving ACs.
OUTSTR [ASCIZ /You have replaced \/]
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSP3
SUBOV1: SOJLE T,SUBST3 ;Came to end just in time
OUTSTR [ASCIZ /
Substitution string itself on page /]
SETZM TYOPNT
TYPDEC CURPAG
OUTSTR [ASCIZ / line /]
TYPDEC ARRL
OUTSTR [ASCIZ / will overflow LINE-EDITOR.
Do you want to make substitution anyway? (type Y or N) /]
PUSHJ P,YESCHK
JRST SUBOV2 ;Go ahead
SUBOV3: MOVE TT,QCHR
CAML TT,SUBONE
JRST SUBOV0
OUTSTR[ASCIZ /
Do you want to skip this line only and continue? (type Y or N) /]
PUSHJ P,YESCHK
JRST QFAST7 ;Skip replacement and do not count
SUBOV0: OUTSTR [ASCIZ /
Substitution aborted.
/]
SETZM QCHR
; TLZ F,OKF
JRST POPJ1C
SUBOV2: SUB B,[50,,0]
JRST SUBST2 ;Continue with insertion for ≤40 more characters
OUTDAT: OUTSTR [ASCIZ /
ARRL /]
SETZM TYOPNT
TYPOCT ARRL
OUTSTR [ASCIZ / A /]
TYPOCT A
OUTSTR [ASCIZ / B /]
TYPOCT B
OUTSTR [ASCIZ / C /]
TYPOCT C
OUTSTR [ASCIZ / D /]
TYPOCT D
OUTSTR [ASCIZ / F /]
TYPOCT F
OUTSTR [ASCIZ / SDSP /]
TYPOCT SDSP
OUTSTR [ASCIZ / QCHR /]
TYPOCT QCHR
OUTSTR [ASCIZ / P /]
TYPOCT P
OUTSTR [ASCIZ / PDL /]
TYPOCT PDL
JFCL
JFCL
JFCL
JFCL
JFCL
JFCL
POPJ P,
;SPOOLC XSPOOL MAIOUT XWRDSP MAISPL XCLOSO XWRPM XWRDON XWRBF3 XWRTAB XWRLUP XWRLIN SPLINI
IMPURE
SPOOLD: BLOCK 21
PURE
XSPOOL: SETOM XGPFLG ;ENTER HERE FOR XSPOOL
JRST .+2
SPOOLC: SETZM XGPFLG ;ENTER HERE FOR LPT SPOOL
MOVEM A,SPLNBR# ;Save number of lines to spool
SETZM MAIFLG ;Not coming from MAIL command
MOVE T,EDFIL
MOVEM T,SPOOLD+7 ;Start with first cha. of real name
MOVE T,FIRPAG
MOVE A,[POINT 6,SPOOLD+7,5] ;Use 1 character of name
PUSHJ P,NUMSIX ;Add the page number
MOVEI TT,'$'
SKIPA
IDPB TT,A
TLNE A,760000
JRST .-2 ;Fill out with '$' characters
MOVE TT,20 ;Limit times to try
SPOOLL: MOVEI T,'LPT'
HRLZM T,SPOOLD+10 ;Six-bit file extension of source
SETZM SPOOLD+11
MOVE T,['SPLSYS']
MOVEM T,SPOOLD+12 ;Six-bit PPN of file
MOVE T,EDFIL
MOVEM T,SPOOLD+13 ;Alias name in six-bit
MOVE T,EDFIL+1
MOVEM T,SPOOLD+14 ;Alias extension in six-bit
MOVE T,EDFIL+3
MOVEM T,SPOOLD+15 ;Alias PPN in six-bit
MOVE T,FIRPAG
HRLM T,SPOOLD+16 ;Alias page number in left half
MOVEI T,21
HRRM T,SPOOLD+16 ;Flags to print headings and delete file
SETZM SPOOLD+17
SETZM SPOOLD+20
OPEN DSKSP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
LOOKUP DSKSP,SPOOLD+7
JRST SPOOLW ;Safe to use this name
CLOSE DSKSP,
MOVEI T,1
ADDM T,SPOOLD+7
SOJG TT,SPOOLL
SPOOLE: OUTSTR [ASCIZ /
Something is wrong with the spooler. Try again later.
/]
JRST POPJ1C
ATTMES: ASCIZ /********************** Attach Buffer Only ***********************
/
PATMES: ASCIZ /****************** Partial Attach Buffer Only *******************
/
;Initialize for text output for special commands
SPLINI: SETZM OBLK
PUSHJ P,XWRBF3 ;To set up 0CNT and 0PNT for first load
MOVE T,[OBUF-1,,OBUF]
BLT T,OBUF+177 ;Clear buffer
MOVEI DSP,XWRDSP
MOVSI E,LSPC+NSPEC
MOVE G,OPNT
POPJ P,
MAIOUT: PUSHJ P,SPLINI
SKIPA T,[440700,,EXTBUF] ;Copy extended command into file
IDPB C,G
ILDB C,T
JUMPN C,.-2
MOVEI C,15
IDPB C,G
MOVEI C,12
IDPB C,G
MOVEI C,14 ;Command on first page, message on 2nd
SKIPLE SPLNBR ;Negative arg means no text from page/buffer
IDPB C,G
PUSHJ P,XWRBUF ;Write out command in first record
MOVE G,OPNT
PUSHJ P,MAISPL ;Now output text
XWRDON: MOVEM G,OPNT
PUSHJ P,XCLOSO
RELEAS DSKSP,
POPJ P,
SPOOLW: ENTER DSKSP,SPOOLD+7
JRST SPOOLE
PUSHJ P,TRAIL0 ;Make sure trailer line is current
PUSHJ P,SPLINI
TRNN F,ATTMOD ;Are we to spool the attachment?
JRST SPOOLZ ;No
MOVEI T,PATMES ;Assume partial buffer
MOVE A,SPLNBR
CAMGE A,ATTNUM ;Are we gonna print whole attach buffer?
TRNN F,ARG ;Not if there was an argument
MOVEI T,ATTMES ;Yes, tell him it's whole buffer
TLOA T,440700
IDPB C,G
ILDB C,T
JUMPN C,.-2
SPOOLY: PUSHJ P,XWRBUF ;Write out header in first block
MOVE G,OPNT
PUSHJ P,MAISPL ;Put out page's text
HRRZ A,(A)
CAIE A,BOTSTR ;Did we print the last line on the page?
SKIPA D,[POINT 7,BOTDSH+LLDESC] ;No
MOVE D,[POINT 7,BOTSTR+LLDESC] ;Yes
SETZM SPLNBR
PUSHJ P,XWRLUP ;Put out trailing row of stars
PUSHJ P,XWRDON ;Close output file
MOVE T,['SPLSYS']
MOVEM T,SPOOLD+12 ;Six-bit PPN of file being spooled
JRST SPALL ;CALL GORIN - ARGUMENTS IN SPOOLD BLOCK
SPOOLZ: PUSH P,SPLNBR
SETZM SPLNBR ;Just ask for one line to be output
MOVE B,ARRL
CAIE B,1 ;Are we gonna print first line on page?
TRNN F,ARG ;Not if an arg was given
SKIPA D,[POINT 7,TOPSTR+LLDESC]
MOVE D,[POINT 7,BOTDSH+LLDESC]
MOVN B,OCNT
MOVSI B,(B)
PUSHJ P,XWRLUP ;Put out header line
POP P,SPLNBR
JRST SPOOLY
;Common line setup and output routine for MAIL and SPOOL.
MAISPL: TRNE F,ATTMOD
JRST MAISP3
MOVE T,LINES
MOVEI A,PAGE
TRNN F,ARG
JRST MAISP4
MOVEI A,ARRLIN ;Spool number of lines from arrow onward
SUB T,ARRL
AOJA T,MAISP5
MAISP3: MOVE T,ATTNUM ;Max number of lines we can spool
MOVEI A,ATTBUF ;Spooling from attach buffer
TRNE F,ARG
MAISP5: CAMGE T,SPLNBR ;Arg given--are there that many lines available?
MAISP4: MOVEM T,SPLNBR# ;Spool max number of lines
SKIPN MAIFLG
JRST MAISP9
TRNN F,ARG
JRST MAISP8
SKIPLE SPLNBR
JRST MAISP6
OUTSTR [ASCIZ/Command line message/]
JRST MAISP2
MAISP6: SETZM TYOPNT
TYPDEC SPLNBR
OUTSTR [ASCIZ/ lines/]
TRNE F,ATTMOD
OUTSTR [ASCIZ/ of attach buffer/]
JRST MAISP2
MAISP8: TRNN F,ATTMOD
OUTSTR [ASCIZ/WHOLE PAGE/]
TRNE F,ATTMOD
OUTSTR [ASCIZ/Attach buffer/]
MAISP2: OUTSTR [ASCIZ/ given to MAIL.
/]
MAISP9: MOVN B,OCNT
MOVSI B,(B)
SETZM EXAFLG# ;Flag not to put pagemarks out as FF on rec boundary
;Fall into XWRLIN to output text
;Subroutine to put out SPLNBR lines whose header is pointed to by A
;EXAFLG, if sets, causes pagemarks to go out as FF's on record boundaries.
XWRLIN: SOSGE SPLNBR ;Output enough lines yet?
POPJ P, ;Yes
HRRZ A,(A)
CAIE A,ATTBUF ;Double check to avoid going past end of buffer
CAIN A,BOTSTR ; or end of page
POPJ P,
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A) ;Is this a page mark?
JRST XWRPM
MOVEI D,LLDESC(A)
HRRZ T,TXTCNT(A)
SKIPN T
TLOA D,350700 ;Empty line--don't put out the empty line's space
HRLI D,440700
HRRI B, ;RH of B counts display position for skipping tabs
XWRLUP: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,G
XWRLP2: AOBJN B,XWRLUP
PUSHJ P,XWRBUF
MOVE G,OPNT
MOVN T,OCNT
HRLI B,(T)
JRST XWRLUP
JRST XWRLIN ;200--previous char was a lf
XWRDSP: JRST XWRLUP ;null, should only occur in middle of pagemark text
PUSHJ P,TELL1 ;rubout
JFCL ;cr
MOVE D,[POINT 8,[BYTE (8)200]] ;lf--make next char get new line
JRST XWRTAB ;tab
PUSHJ P,TELL5 ;ff
PUSHJ P,TELL6 ;alt
XWRTAB: IDPB C,G
HRROI C,-10
IORI C,(B)
SUB B,C
ADD D,BTAB2+10(C)
JUMPGE D,.+2
ADD D,[XOR 1]
SOJA B,XWRLP2
XCLOSO: PUSHJ P,CLOSO2
XWRBUF: OUT DSKSP,[-200,,OBUF-1↔0]
AOSA OBLK
PUSHJ P,TELLZ
XWRBF3: PUSH P,T
JRST WRBF3
XWRPM: SKIPN EXAFLG
JRST XWRPM2
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Force out partial buffer
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVSI E,LSPC!NSPEC
MOVEI C,14 ;Put out FF at beginning of new record
IDPB C,G
AOBJN B,XWRLIN
PUSHJ P,TELLZ ;One char can't fill up buffer!
XWRPM2: MOVE D,[440700,,LLDESC]
SKIPE MAIFLG
TRCA D,LLDESC≠PMTXT ;MAIL--output the model pagemark w/o page number
ADDI D,(A) ;SPOOL--output the pagemark as displayed
JRST XWRLUP ;No need to set up RH of B--no tabs in pagemark text
BEGIN SPSUB
GLOBAL DSKSP,P,F,A,B,C,D,%SEG
;PDLEN←←20
IMPURE
SPRUNB: ;NEXT THREE ARE NAME, PPN AND ZERO
SPLNAM: SIXBIT /[LIST]/ ;SPOOLER'S NAME
SPLPPN: SIXBIT /SPLSYS/ ;SPOOLER'S PPN
0 ;ZERO TO KEEP IT RUNNING.
XSRUNB:
XSPNAM: SIXBIT /[XSPL]/
SIXBIT /SPLSYS/
0
SPLJBN: BLOCK 1
RETADD: BLOCK 1 ;SAVE HIS RETURN ADDRESS
↑XGPFLG:0 ;-1 FOR XGP CALL, 0 FOR LPT
;PDLIST: BLOCK PDLEN
RQIOWD: IOWD 200,CMDBUF
IOWD 16,XFNTCM
0
XFNTCM: REPEAT 10,{-1}
'FIX25 '
'FNT '
0
'XGPSYS'
0
0
PURE
CFORM←←0
RQNAM←←1
RQJOB←←2
FDEV←←3
DEVMOD←←4
FSIZE←←5
RQTIME←←6
FNAME←←7
FPPN←←12
CBITS←←16
PSPEC←←20
↑SPALL: MOVEM 17,SAVEAC+17 ;SAVE AC 17
MOVEI 17,SAVEAC ;LOAD BLT POINTER
BLT 17,SAVEAC+16 ;SAVE THE AC'S
MOVE P,SAVEAC+17 ;Restore pdl pointer
; MOVE P,[IOWD PDLEN,PDLIST] ;MAKE A PDL
PUSH P,[CAM MRET] ;SAVE RETURN ADDRESS
MOVEM P,RETADD ;SAVE PRESENT PDP.
SETZM CMDBUF
MOVE C,[CMDBUF,,CMDBUF+1]
BLT C,CMDBUF+177
MOVE D,[SPOOLD,,CMDBUF] ;BLT AC
BLT D,CMDBUF+PSPEC-1 ;LAST WORD OF DESTINATION
MOVEI D,0
DSKPPN D,
SKIPN CMDBUF+FPPN ;IS THERE AN EXPLICIT FILE PPN?
MOVEM D,CMDBUF+FPPN ;NO. SET ONE.
PUSHJ P,SPOOLZ ;CALL COMMON PORTION
RETURN: MOVE P,RETADD
CPOPJ: POPJ P,
SPOOLZ: PUSHJ P,SPLSTS ;MAKE SURE THE SPOOLER'S ALIVE.
SKIPN B,CMDBUF+FDEV ;ANY DEVICE THERE?
MOVSI B,'DSK' ;NO USE DISK
CAME B,['DSK ']
JRST NOLOOK ;DON'T DO LOOKUP IF NOT DISK.
MOVEI A,17
SETZ C,
OPEN DSKSP,A
JRST NODISK
;LOOKUP THE FILE THAT HE GAVE ME.
MOVE D,[CMDBUF+FNAME,,A]
BLT D,D
HLLZ B,B
LOOKUP DSKSP,A
JRST [TTCALL 3,[ASCIZ/Spool: lookup fails
/]
JRST RETURN]
MOVS D,D ;SIZE OF FILE
MOVM D,D ;GET MAGNITUDE
LSH D,-7 ;CONVERT TO BLOCKS
CLOSE DSKSP,
JRST STASH
NOLOOK: MOVEI D,100 ;HERE IF NOT DISK, ASSUME SIZE.
MOVEI A,17
MOVSI B,'DSK' ;OPEN A DISK CHANNEL
SETZ C,
OPEN DSKSP,A
JRST NODISK
STASH: ;SETUP CMDBUF AND WRITE THE FILE
MOVEM D,CMDBUF+FSIZE ;STASH FILE SIZE
TIMER A, ;GET TIME
IDIVI A,74*74 ;MAKE MINUTES
DATE B, ;GET DATE
HRL A,B ;COMPUTE "NOW"
CAMLE A,CMDBUF+RQTIME ;SKIP IF ALREADY SET BIGGER.
MOVEM A,CMDBUF+RQTIME ;WAS SET SMALL. SET IT TO NOW.
GETPPN A, ;GET USER NAME
MOVEM A,CMDBUF+RQNAM
MOVE A,['NP ',,1]
MOVEM A,CMDBUF+CFORM
SETO B,
TTCALL 6,B
PJOB A,
HRL B,A
MOVEM B,CMDBUF+RQJOB ;SAVE JOB#,,LINE NUMBER OF REQUESTOR
DATE A,
TIMER B,
LSH A,30
OR A,B
AGAIN: MOVSI B,'SPX'
SKIPE XGPFLG
MOVSI B,'XSP'
SETZ C,
MOVE D,SPLPPN
LOOKUP DSKSP,A
JRST .+2
AOJA A,AGAIN
MOVSI B,'SPX'
SKIPE XGPFLG
MOVSI B,'XSP'
SETZ C,
MOVE D,SPLPPN
ENTER DSKSP,A
AOJA A,AGAIN
MOVE F,[IOWD 16,XFNTCM]
SKIPN XGPFLG
MOVEI F,0
MOVEM F,RQIOWD+1
OUTPUT DSKSP,RQIOWD
STATZ DSKSP,740000
JRST OUTERR
CLOSE DSKSP,
RELEAS DSKSP,
SETZM MAILBK
MOVE A,[XWD MAILBK,MAILBK+1]
BLT A,MAILBK+37
MOVE A,SPLJBN
MOVEI B,MAILBK
SEND A
JFCL
POPJ P,
SPLSTS: SKIPE XGPFLG
SKIPA A,XSPNAM
MOVE A,SPLNAM
CALL A,[SIXBIT/NAMEIN/]
PUSHJ P,INTSPL ;OUGHT TO INIT SPOOLER
MOVEM A,SPLJBN ;INTSPL ALSO RETURNS A.
JBTSTS A,
TLNN A,20000
POPJ P, ;QUICK RETURN
TTCALL 3,[ASCIZ/
Spool: The spooler has crashed. Your output will be printed after
the spooler is restarted.
/]
POPJ P,
;SEE ABOUT STARTING A SPOOLER
INTSPL: TRNE A,2 ;SKIP IF NO JOBS LOGGED IN.
JRST MULSPL ;OOPS MORE THAN 1 SPOOLER ALREADY
MOVEI A,SPRUNB ;LOAD THE ADDRESS OF THE RUN BLOCK
SKIPE XGPFLG
MOVEI A,XSRUNB
CALL A,['WAKEME']
JRST NOWAKE ;WAKEME FAILURE
MOVEI B,30 ;WAIT FOR SPOOLER TO HAPPEN
INTSPS: MOVEI A,1
SLEEP A, ;SLEEP AND WAIT FOR SPOOLER TO BE ALIVE.
SKIPE XGPFLG
SKIPA A,XSPNAM
MOVE A,SPLNAM
CALL A,[SIXBIT/NAMEIN/]
SOJGE B,INTSPS
JUMPGE B,CPOPJ
JRST INTCFN ;CONFUSION. I JUST MADE A SPOOLER
NODISK: TTCALL 3,[ASCIZ/Spool: init failed on dsk
/]
JRST RETURN
OUTERR: TTCALL 3,[ASCIZ/Spool: output error on dsk
/]
JRST RETURN
INTCFN: TTCALL 3,[ASCIZ/Spool: I just made a spooler, but now i can't find it.
/]
JRST RETURN
MULSPL: TTCALL 3,[ASCIZ/Spool: There are multiple spoolers. Everyone loses
/]
JRST RETURN
NOWAKE: TTCALL 3,[ASCIZ/Spool: The WAKEME uuo to start the spooler failed.
/]
JRST RETURN
BEND
;TELBUF,CHKUP,CHECKU,CHTEXT,ASCASC,CHOUT3,CHOUT6
;EXTERNAL $ADTYP,$OPLOO
IMPURE
LTELBF←←300 ;Length of buffer for report trouble in TELLME
SAVEAC: BLOCK 20
MAILBK: ;SAVE SPACE ;block for mailer disk output
CMDBUF: ;Block for spooler disk output
TELBUF: BLOCK LTELBF ;WE MAY USE SOME EXISTING SPACE WHEN DEBUGGED
CHFILE: SIXBIT /ERR/
SIXBIT /001 /
0
SIXBIT / EALS/
CHUSET: USETO DSKCH,1 ;Address field set by a UGETF
TELFL3: -1 ;Counter to cause checksum every N times
PURE
CHEXT: SIXBIT /001 /
CHEXTA: SIXBIT /ALS /
CHEXTM: SIXBIT /ME1 /
CHPPN: SIXBIT / EALS/
CHKUP: MOVEI T,0
MOVE TT,[400000-ENDPUR,,0]
ADD T,400000(TT)
AOBJN TT,.-1
JFCL
POPJ P,
MONTH: ASCII /Jan. /
ASCII /Feb. /
ASCII /Mar. /
ASCII /Apr. /
ASCII /May /
ASCII /June /
ASCII /July /
ASCII /Aug. /
ASCII /Sep. /
ASCII /Oct. /
ASCII /Nov. /
ASCII /Dec. /
SUMERR: ASCIZ /Checksum error /
CHREGE: ASCIZ / Accum. /
CHINDE: ASCIZ / Index /
CHADDR: ASCIZ / Eff.Address /
CHADDC: ASCIZ / held /
CHOUTB: ASCIZ / Out of bounds/
CHCOMM: ASCIZ /Last com.addr./
CHCHAR: ASCIZ /Last chars/
CHARGU: ASCIZ /Last arguments/
CHPDLM: ASCIZ /PDL addresses /
CHREGS: ASCIZ /All registers /
CHREG2: ASCIZ /Flags, point /
CHRETU: ASCIZ /Return-2 /]
CHALIA: ASCIZ / Alias /]
CHKCUR: ASCIZ/
CURPAG FIRPAG ONE PAGES FINPAD DIREND+1
/]
CHKCU2: ASCIZ/
DIRPT DIRP1 DIR DIREND
/]
;Copies text from location pointed to by B to location pointer to by A (80 chars.)
CHTEXT:MOVEI TT,120
ILDB C,B
JUMPE C,.+3
IDPB C,A
SOJG TT,.-3
POPJ P,
CHCRLF: MOVEI C,15
IDPB C,A
MOVEI C,12
IDPB C,A
POPJ P,
;Transfer 5 characters ascii in T to ascii by pointer A, ignoring nulls
;and replacing special characters by 2-char. strings.
;Note that T is displaced to right
ASCASC: MOVE B,[POINT 7,T,0] ;Yes this IS right
MOVEI TT,5
ASCAS2: ILDB C,B
JUMPE C,ASCAS3
CAIN C,11
JRST [MOVEI C,"T"↔IDPB C,A↔MOVEI C,"B"↔IDPB C,A↔POPJ P,]
CAIN C,12
JRST [MOVEI C,"L"↔IDPB C,A↔MOVEI C,"F"↔IDPB C,A↔POPJ P,]
CAIN C,13
JRST [MOVEI C,"V"↔IDPB C,A↔MOVEI C,"T"↔IDPB C,A↔POPJ P,]
CAIN C,14
JRST [MOVEI C,"F"↔IDPB C,A↔MOVEI C,"F"↔IDPB C,A↔POPJ P,]
CAIN C,15
JRST [MOVEI C,"C"↔IDPB C,A↔MOVEI C,"R"↔IDPB C,A↔POPJ P,]
CAIN C,175
JRST [MOVEI C,"A"↔IDPB C,A↔MOVEI C,"T"↔IDPB C,A↔POPJ P,]
CAIN C,177
JRST [MOVEI C,"B"↔IDPB C,A↔MOVEI C,"S"↔IDPB C,A↔POPJ P,]
IDPB C,A
ASCAS3: SOJG TT,ASCAS2
POPJ P,
;Changes six-bit in D into ascii omitting blanks and stores at pointer A
CHOUT3: MOVEI T,3
SKIPA
CHOUT6: MOVEI T,6
MOVE B,[POINT 6,D]
ILDB C,B
JUMPE C,.+3
ADDI C,40 ;Convert to ASCII
IDPB C,A
SOJG T,.-4
POPJ P,
COMOUT: LDB C,[POINT 2,TT,17]
ADDI C,60
IDPB C,A
LDB C,[POINT 7,TT,35]
IDPB C,A
POPJ P,
;Converts # in left half of TT into ascii and stores at pointer A
LHOCTS: MOVEI C,6
MOVEI T,0
LSHC T,3
ADDI T,60
IDPB T,A
SOJG C,.-4
POPJ P,
;This warns of trouble once and inhibits WRPAGE. If user presists (like I will do
;during testing) no further warning will be given but E may blow in other ways.
CHECKU: SKIPL 115 ;Check protection status of upper
POPJ P, ;Don't bother if upper is not write protected
AOS C,TELFL3 ;Add to WRPAGE count
TRNE C,7 ;Do a check sum only every 8 times
POPJ P, ;Not this time
SKIPE TELLFL#
POPJ P, ;One warning should be enough
SETOM TELLFL
PUSH P,T
PUSH P,TT
PUSHJ P,CHKUP
CAME T,CHKSUM
JRST .+4
POP P,TT
POP P,T
POPJ P,
POP P,TT
POP P,T
PUSHJ P,FBI
PUSHJ P,MACSTP
OUTSTR [ASCIZ /
***** UPPER SEGMENT CHECKSUM ERROR!!!! ***** TELL EVERYONE! KILL SEGMENT!! *****
Command aborted; next attempt to write out page will work but may garbage page./]
SETO A,
BEEP A, ;Beep poor guy to wake him up
CLRBFI ;Save him from himself
MOVE P,[-LPDL+1,,PDL]
JRST POPJ1
STOPJC: OUTSTR [ASCIZ/
One moment please--free storage error detected./]
PUSHJ P,MAP ;Make a free storage map for ALS
PUSHJ P,TELLX
ASCIZ/Free storage error/
;FILEID TELLME FBI
TELLME: OUTSTR [ASCIZ /
You are under surveillance! /]
PUSHJ P,FBI
POPJ P,
;Put date and time, programmer, file name, page and line numbers on first line
FILEID: DATE C, ;GET DATE
MOVEI D,0
IDIVI C,=31
MOVE T,D
ADDI T,1 ;This is the day
PUSHJ P,NUMSTR ;Get it in 7-bit
MOVEI E,40
IDPB E,A
MOVEI D,0
IDIVI C,=12
MOVE C,MONTH(D) ;This is the month in 7-bit
MOVEM C,1(A)
ADDI A,2
HRLI A,440700
TIMER B, ;GET TIME
IDIVI B,74*74 ;MAKE MINUTES
MOVEI C,0
IDIVI B,=60 ;Hour is in B and minutes in C
MOVE T,B
PUSHJ P,NUMSTR
MOVEI B,":"
IDPB B,A
MOVE T,C
PUSHJ P,NUMSTR
IDPB E,A
IDPB E,A
MOVE D,RPPN ;Get users name
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
IDPB E,A
IDPB E,A
MOVE D,PPN ;Get users alias
CAMN D,RPPN
JRST .+11
MOVE B,[POINT 7,CHALIA]
PUSHJ P,CHTEXT
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
IDPB E,A
IDPB E,A
MOVE D,EDFIL-1
CAMN D,['DSK ']
JRST .+5
PUSHJ P,CHOUT3
MOVEI C,":"
IDPB C,A
IDPB E,A
MOVE D,EDFIL ;Get file name
PUSHJ P,CHOUT6
HLLZ D,EDFIL+1 ;Get extension
JUMPE D,.+4 ;May be missing
MOVEI C,"."
IDPB C,A
PUSHJ P,CHOUT3
MOVE D,EDFIL+3 ;Get file PPN
JUMPE D,.+12
MOVEI C,"["
IDPB C,A
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
MOVEI C,"]"
IDPB C,A
HRRZ C,EDFIL+4
CAIE C,777777
JRST .+5
MOVEI C,"/"
IDPB C,A
MOVEI C,"N"
IDPB C,A
IDPB E,A
MOVEI C,"P"
IDPB C,A
MOVE T,CURPAG ;Get page number
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"o"
IDPB C,A
MOVEI C,"f"
IDPB C,A
MOVE T,PAGES
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"L"
IDPB C,A
MOVE T,ARRL ;Get line number
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"o"
IDPB C,A
MOVEI C,"f"
IDPB C,A
MOVE T,LINES
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"(" ;Show TOPWIN and BOTWIN in ( )
IDPB C,A
MOVE T,TOPWIN
JUMPGE T,.+4
MOVMS T
MOVEI C,"-"
IDPB C,A
PUSHJ P,NUMSTR
MOVEI C,","
IDPB C,A
MOVE T,BOTWIN
JUMPGE T,.+4
MOVMS T
MOVEI C,"-"
IDPB C,A
PUSHJ P,NUMSTR
MOVEI C,")"
IDPB C,A
IDPB E,A
MOVE T,CHARS
PUSHJ P,NUMSTR
PUSHJ P,CHCRLF
POPJ P,
FBI: MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE P,SAVEAC+17 ;No reason to make another push-down list
SETZM TELBUF
MOVE T,[TELBUF,,TELBUF+1]
BLT T,TELBUF+LTELBF-1 ;Clear the buffer
MOVEI T,32 ;ALS's line
BEEP T,
MOVE A,[POINT 7,TELBUF]
MOVEI C,14 ;Put each entry on separate page
IDPB C,A
MOVEI C,"∂"
IDPB C,A
PUSHJ P,FILEID
MOVEI E,11
;Put fatal error message next if there is one
SKIPN TELFL2
JRST CHSUME
SETZM TELFL2
MOVE B,[POINT 7,0]
HRR B,40 ;Get starting address from JOBUUO
ILDB C,B
JUMPE C,.+3
IDPB C,A
JRST .-3
PUSHJ P,CHCRLF
;Put CHECKSUM error on the second line if one exists
CHSUME: PUSHJ P,CHKUP
SUB T,CHKSUM
JUMPE T,CHKUP9
MOVE B,[POINT 7,SUMERR]
PUSHJ P,CHTEXT
MOVE TT,T
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI E,40
IDPB E,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
MOVEI C,15 ;End CHKSUM line
IDPB C,A
MOVEI C,12
IDPB C,A
;Special info for help with the directory trouble
CHKUP9: MOVE B,[POINT 7,CHKCUR]
PUSHJ P,CHTEXT
MOVEI E,11
MOVE T,CURPAG
PUSHJ P,NUMSTR
IDPB E,A
MOVE T,FIRPAG
PUSHJ P,NUMSTR
IDPB E,A
MOVE T,FIRPAG+1
PUSHJ P,NUMSTR
IDPB E,A
MOVE T,PAGES
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"+"
SKIPGE FNDPAD
MOVEI C,"-"
IDPB C,A ;Report FNDPAG direction
IDPB E,A
MOVE T,DIREND+1
PUSHJ P,NUMSTR ;Report the last record number
MOVE B,[POINT 7,CHKCU2]
PUSHJ P,CHTEXT
MOVE TT,DIRPT
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI C,40
IDPB C,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
IDPB E,A
MOVE TT,DIRP1
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI C,40
IDPB C,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
IDPB E,A
MOVE TT,DIR
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI C,40
IDPB C,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
IDPB E,A
MOVE TT,DIREND
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI C,40
IDPB C,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
PUSHJ P,CHCRLF
;Put blow-up location and instruction for reference on third line
CHKUP2: MOVEI E,40
MOVE B,[POINT 7,CHRETU]
PUSHJ P,CHTEXT
IDPB E,A
MOVE T,SAVEAC+17 ;Get P value at entry time
HRRZ TT,-1(T) ;Get POPJ address
SUBI TT,2 ;We want location before PUSHJ
HRLZ TT,TT
SKIPE T,ILMADR# ;Was this an ill mem ref?
HRLZ TT,T ;Yes get address
HLRZ D,TT
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
IDPB E,A
IDPB E,A
MOVE TT,(D) ;Get the instruction itself
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
IDPB E,A
PUSHJ P,LHOCTS ;Convert former right helf into OCT string
PUSHJ P,CHCRLF
;Report contents of specified register and effective address
CHKUPA: MOVE B,[POINT 7,CHREGE]
PUSHJ P,CHTEXT
MOVE D,(D) ;Get instruction into D
MOVE B,[POINT 4,D,12]
LDB T,B ;Get register address
MOVEM T,TSAVE#
PUSHJ P,OCTSTR ;Report the register
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE
MOVE T,SAVEAC(T) ;Get contents
PUSHJ P,OCTSTR ;Want it in OCTAL
MOVE B,[POINT 4,D,17] ;Pointer to index position
LDB T,B ;Get its number
MOVEM T,TSAVE# ;We will need this again
SETZM TTSAVE# ;Ready for no index case
JUMPE T,.+13
MOVE B,[POINT 7,CHINDE]
PUSHJ P,CHTEXT ;Write text
MOVE T,TSAVE ;Get index address back
PUSHJ P,OCTSTR ;The index
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE ;And again
HRRZ T,SAVEAC(T) ;Get contents of index
MOVEM T,TTSAVE ;Save to add to address
PUSHJ P,OCTSTR ;Report contents in OCT of index register
MOVE B,[POINT 18,D,35]
LDB TT,B
ADDB TT,TTSAVE
MOVE B,[POINT 7,CHADDR] ;Some text
PUSHJ P,CHTEXT
HRLZ TT,TTSAVE
PUSHJ P,LHOCTS ;Report effective address itself
MOVE TT,TTSAVE
CAIG TT,@JOBREL ;Is address above job's lower segment?
JRST .+4 ;No
CAIG TT,ENDPUR ;Is it beyond limit of upper segment?
CAIGE TT,400000 ;or maybe in between lower and upper?
JRST CHKUPZ ;It IS out of bounds
CAILE TT,17
MOVE T,(TT)
CAIG TT,17
MOVE T,SAVEAC(TT)
MOVEM T,TSAVE
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE
PUSHJ P,OCTSTR ;Report OCT contents of effective address
JRST CHKUPB
CHKUPZ: MOVE B,[POINT 7,CHOUTB]
PUSHJ P,CHTEXT ;Report address out of bounds
CHKUPB: PUSHJ P,CHCRLF
;Put the last seven command addresses on the next line
MOVEI E,11
MOVE B,[POINT 7,CHCOMM] ;Some text
PUSHJ P,CHTEXT
IDPB E,A
HRLZ TT,LSTCOM
PUSHJ P,LHOCTS
IDPB E,A
HRLZ TT,LSTCO2
PUSHJ P,LHOCTS
IDPB E,A
HRLZ TT,LSTCO3
PUSHJ P,LHOCTS
IDPB E,A
HRLZ TT,LSTCO4
PUSHJ P,LHOCTS
IDPB E,A
HRLZ TT,LSTCO5
PUSHJ P,LHOCTS
IDPB E,A
HRLZ TT,LSTCO6
PUSHJ P,LHOCTS
IDPB E,A
HRLZ TT,LSTCO7
PUSHJ P,LHOCTS
PUSHJ P,CHCRLF
;Put the last seven command characters on the next line
MOVE B,[POINT 7,CHCHAR] ;Some text
PUSHJ P,CHTEXT
IDPB E,A
MOVE T,LSTCH1
PUSHJ P,ASCASC ;Move ascii to ascii
IDPB E,A
MOVE T,LSTCH2
PUSHJ P,ASCASC ;Move ascii to ascii
IDPB E,A
MOVE T,LSTCH3
PUSHJ P,ASCASC ;Move ascii to ascii
IDPB E,A
MOVE T,LSTCH4
PUSHJ P,ASCASC ;Move ascii to ascii
IDPB E,A
MOVE T,LSTCH5
PUSHJ P,ASCASC ;Move ascii to ascii
IDPB E,A
MOVE T,LSTCH6
PUSHJ P,ASCASC ;Move ascii to ascii
IDPB E,A
MOVE T,LSTCH7
PUSHJ P,ASCASC ;Move ascii to ascii
PUSHJ P,CHCRLF
;Put the last seven command arguments on the next line
CHKUPC: MOVE B,[POINT 7,CHARGU] ;Some text
PUSHJ P,CHTEXT
IDPB E,A
MOVE C,LSTARG
PUSHJ P,CHKUPN ;Separate out REL and NEG flags and print
MOVE C,LSTAR2
PUSHJ P,CHKUPN
MOVE C,LSTAR3
PUSHJ P,CHKUPN
MOVE C,LSTAR4
PUSHJ P,CHKUPN
MOVE C,LSTAR5
PUSHJ P,CHKUPN
MOVE C,LSTAR6
PUSHJ P,CHKUPN
MOVE C,LSTAR7
PUSHJ P,CHKUPN
PUSHJ P,CHCRLF
repeat 1,<
;This code is to list the files that are currently shown by the ∃ command.
MOVEM A,TYOPNT
PUSHJ P,EXISTF
JFCL ;Exist is set up for a skip return
MOVE A,TYOPNT
PUSHJ P,CHCRLF
>
MOVEI E,40
MOVE B,[POINT 7,CHREG2] ;F register and point
PUSHJ P,CHTEXT
IDPB E,A
MOVE TT,SAVEAC
PUSHJ P,OCTASC
IDPB E,A
IDPB E,A
HRRZ T,SAVEAC+17
SUBI T,PDL
PUSHJ P,NUMSTR
PUSHJ P,CHCRLF
REPEAT 0,<
;Put the registers next
CHKUPD: MOVE B,[POINT 7,CHREGS] ;Some text
PUSHJ P,CHTEXT
PUSHJ P,CHCRLF
MOVNI D,20
HRLZS D
MOVEI C,6
MOVE TT,SAVEAC(D)
PUSHJ P,OCTASC
IDPB E,A
AOBJP D,.+7
SOJG C,.-4
MOVEI C,15
IDPB C,A
MOVEI C,12
IDPB C,A
JRST .-12
PUSHJ P,CHCRLF
>
;Put POPJ addresses from PDL on the next two lines if space permits
MOVEI E,11
MOVE B,[POINT 7,CHPDLM] ;Some text
PUSHJ P,CHTEXT
; PUSHJ P,CHCRLF
MOVSI D,-20 ;Limit list to 16
ADDI D,PDL
CHKUP3: HRRZ C,D
SUBI C,PDL
TRNN C,7
PUSHJ P,CHCRLF
HRRZ C,A ;POINTER ADDRESS
SUBI C,TELBUF-1
CAIG C,3 ;Allow for maximum of 15 characters
JRST CHKUP4 ;Not enough room so stop
HRLZ TT,(D) ;Get popj address
JUMPN TT,CHKUP5 ;End of the list?
SKIPN TTSAVE# ;Allow one zero
JRST CHKUP4 ;Stop in this case
CHKUP5: MOVEM TT,TTSAVE
PUSHJ P,LHOCTS
IDPB E,A
AOBJN D,CHKUP3
CHKUP4: MOVEI C,15
MOVEI D,12
IDPB C,A
IDPB D,A
HRRZ T,A
SUBI T,TELBUF-1
PUSHJ P,NUMSTR ;Report words used for record
IDPB C,A ;Separate records
IDPB D,A
IDPB C,A
IDPB D,A
HRRZ T,RPPN
CAMN T,[SIXBIT/ ALS/]
JRST [MOVE T,CHEXTA ;Start with extension of ALS
JRST CHKUP6]
CAMN T,[SIXBIT/ ME/] ;Start with EXT of ME1 in this case
SKIPA T,CHEXTM
MOVE T,CHEXT ;Start with EXT of 001
CHKUP6: MOVEM T,CHFILE+1
WRITIT: OPEN DSKCH,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,CHPPN
MOVEM T,CHFILE+3 ;This must be reset
LOOKUP DSKCH,CHFILE
JRST .+2 ;Assume that it does not exist
MOVEM T,CHFILE+3 ;This must be reset
ENTER DSKCH,CHFILE
JRST WRITT2
UGETF DSKCH,T
HRRM T,CHUSET
XCT CHUSET
OUT DSKCH,[-LTELBF,,TELBUF-1↔0]
SKIPA
JRST WRITT2
CLOSE DSKCH, ;We assume that 128 words will be enough always
RELEAS DSKCH,
MRET: MOVSI 17,SAVEAC
BLT 17,17
POPJ P,
WRITT2: MOVE T,CHFILE+1 ;If file is busy create a new one
ADD T,[1,,0]
MOVEM T,CHFILE+1
CLOSE DSKCH,
JRST WRITIT ;Try again
;Used to extract and print argument, and sign if relative
CHKUPN: HRRE T,C ;Get argument part
JUMPL T,CHKN1
TLNN C,REL ;Is it relative?
JRST CHKUPP ;No
SKIPA C,["+"] ;Yes
CHKN1: MOVEI C,"-"
MOVM T,T ;Make it positive
IDPB C,A ;So write sign
CHKUPP: PUSHJ P,NUMSTR
IDPB E,A
POPJ P,
;MAP
MAPMES: ASCIZ /
FSUSE FSFREE FSTOT DIR PAGE ATT FSBEG
/
MAPHED: ASCIZ /
0 1 2 3 4 5 6 7
/
DSKMAP←←6
IMPURE
MAPILE: SIXBIT /ETVMAP/
SIXBIT /001 /
0
SIXBIT / EALS/
PURE
MAPEXT: SIXBIT /001 /
MAPPPN: SIXBIT / EALS/
MAPCR: TYPCHR "
" ;New line needed
HRRZ D,TYOPNT
SUBI D,TELBUF ;How many words have been used?
CAIGE D,157 ;We reserve 17 words for each line
JRST MAPCR2 ;It is safe to add another line to map
OUT DSKMAP,[-200,,TELBUF-1↔0] ;Empty buffer
SKIPA
JRST MAP10 ;Something very wrong so get out
MOVE A,[440700,,TELBUF] ;Use this buffer to accumulate text
MOVEM A,TYOPNT
SETZM TELBUF
MOVE G,[TELBUF,,TELBUF+1]
BLT G,TELBUF+177 ;Clear the buffer
MAPCR2: MOVEI D,100 ;Allow 64 cell symbols on a line
ADDI E,100
TRNN E,777
TYPCHR "
" ;An extra CR for readability
TYPOCT E
TYPCHR " " ;A TAB
POPJ P,
MAPT2: MOVE T,MAPILE+1 ;If file exists create a new name
ADD T,[1,,0]
MOVEM T,MAPILE+1
CLOSE DSKMAP
JRST MAPIT ;Try again
;Code to make a map of free storage
MAP: MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE P,SAVEAC+17 ;No reason to make another push-down list
MOVE T,MAPEXT ;Start with EXT of 001
MOVEM T,MAPILE+1
MAPIT: OPEN DSKMAP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,MAPPPN
MOVEM T,MAPILE+3 ;This must be reset
LOOKUP DSKMAP,MAPILE
JRST .+2 ;Assume that it does not exist
JRST MAPT2 ;This name is already used
ENTER DSKMAP,MAPILE
JRST MAPT2
SETZM TELBUF
MOVE T,[TELBUF,,TELBUF+1]
BLT T,TELBUF+177 ;Clear the buffer
MOVE A,[440700,,TELBUF] ;Use this buffer to accumulate text
PUSHJ P,FILEID ;Get file identification data
MOVE B,[POINT 7,MAPMES]
PUSHJ P,CHTEXT ;Print labels
MOVE T,FSUSE ;Cells occupied
PUSHJ P,NUMSTR
MOVEI E,11
IDPB E,A
MOVE T,FSFREE ;Cells free
PUSHJ P,NUMSTR
IDPB E,A
MOVE T,FSMAX
SUB T,FSMIN
PUSHJ P,NUMSTR ;Total number of cells in free storage
IDPB E,A
MOVE G,FSMIN
ADDI G,1
MOVE T,DIR
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of Directory cells
IDPB E,A
MOVE T,PAGE
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of page cells
IDPB E,A
HRRZ T,ATTBUF
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of ATTBUF
IDPB E,A
MOVE T,FSBEG
SUB T,FSMIN
PUSHJ P,OCTSTR ;Relative start of FRFREE
MOVE B,[POINT 7,MAPHED]
PUSHJ P,CHTEXT
MOVEM A,TYOPNT ;Prime for TYPCHR
MOVE B,FSMIN ;Start at beginning of free storage
MOVEI D,100 ;Allow 64 cells per line in map
MOVEI E,0 ;Used for cell count
TYPOCT E
TYPCHR " " ;A TAB
MAP1: HRRZ T,(B) ;Get the number of words for this line
HLRZ C,(B) ;and the identifier
CAIG C,2 ;Is this space occupied?
JRST [MOVE G,T↔JRST MAP2]
CAIE C,777777 ;Then it should be empty
JRST MAP3 ;Something is wrong
MOVE G,(B) ;It may be, so match entire word
MAP2: MOVE TT,B
ADD TT,T ;This will be the new B
CAML TT,FSMAX
JRST MAP10 ;We are at the end
CAME G,-1(TT) ;Check the two end counts
JRST MAP3 ;We're in trouble
CAIN C,1 ;Is it a directory line?
JRST MAP4 ;Yes
CAIN C,2 ;Or maybe text?
JRST MAP4A ;Yes
CAIN C,777777 ;Surely must be empty then?
JRST MAP6 ;Yes
;Something is wrong, try to fix
TYPCHR "?" ;Unknown identifier
SKIPA
MAP3: TYPCHR "≠" ;Counts are not equal
MAP3A: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
AOS TT,B
CAML B,JOBREL
JRST MAP9
MOVE C,(B)
CAME C,[-1] ;Is it falsely labeled free storage?
JRST MAP1 ;It does not seem to be
TYPCHR " " ;Looks like it is
JRST MAP3A ;Keep looking
;Directory space
MAP4: TYPCHR "D"
SOJ T,
MAP4B: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR "."
SOJG T,MAP4B
JRST MAP8
;Text space
MAP4A: TYPCHR "T"
SOJ T,
MAP5: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR "+"
SOJG T,MAP5
JRST MAP8
;Free storage space
MAP6: TYPCHR "F"
SOJ T,
MAP7: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR " "
SOJG T,MAP7
MAP8: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
MOVE B,TT
CAMGE B,JOBREL
JRST MAP1
MAP9: TYPCHR "
"
OUT DSKMAP,[-200,,TELBUF-1↔0]
SKIPA
JFCL
CLOSE DSKMAP,
RELEAS DSKMAP,
MOVSI 17,SAVEAC
BLT 17,17
POPJ P,
MAP10: TYPCHR "E"
SUB TT,JOBREL
TYPOCT TT ;As a clue as to why
JRST MAP9
;PAREN
PARSYM: "(",,")"
"→",,"←" ;Standard symbol table
"⊂",,"⊃"
"`",,"'"
"≤",,"≥"
"{",,"}"
"<",,">"
"[",,"]"
LPARSM←←.-PARSYM
;Extend command to accept specification of bracketing pair
PAREN: MOVE T,EXTPNT ;Data already gobbled into EXTBUF by EXTEND
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,TYI
JRST PAREND ;Use default values
MOVSI A,(C)
PUSHJ P,TYI
JRST PARENB ;Only got one char.
HRRI A,(C)
PUSHJ P,TYI
JRST PARENA ;Ok, no garbage followed the two chars
SETZM TYIPNT
SORRY Only two characters are allowed after command delimiter.
JRST PPJ1CR
PARENB: MOVEI TT,LPARSM-1
PAREN1: HLLZ D,PARSYM(TT) ;Pick up a left half symbol
CAMN A,D ;Is this the same?
JRST PARENC ;Yes
SOJGE TT,PAREN1
OUTSTR[ASCIZ/Left symbol "/]
HLRZ C,A ;Get symbol that was typed in
PUSHJ P,PRNTCH ; and type it back out.
OUTSTR[ASCIZ/" not in table. Must type right symbol explicitly.
/]
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
PAREND: SKIPA A,PARSYM ;Get default chars
PARENC: HRR A,PARSYM(TT) ;Get corresponding right-symbol from table
PARENA: HLRZM A,LEFTC ;Got exactly two chars--store the first.
HRRZM A,RITEC ;Store second one.
SETZM TYOPNT
OUTSTR [ASCIZ /Using symbol pair /]
MOVE C,LEFTC
PUSHJ P,PRNTCH ;Print char using symbols for non-printing chars.
MOVE C,RITEC
PUSHJ P,PRNTCH ;Print right char.
OUTSTR [ASCIZ/
/]
JRST POPJ1C
;PARSAV PARL PARR PAR PARFND PARB PAREXT PARRCD PARNUL
IMPURE
LEFTC: "(" ;Left-symbol
RITEC: ")" ;Right symbol
PARMAX: 77777 ;Desired maximum level
PARMIN: -77777 ;Desired minimum level
PARGDP: 0 ;Greatest level
PARLDP: 0 ;Lowest level
PARTMS: 0 ;Times at max level
PARTML: 0 ;Times at min level
PARCT: 0 ;Character count on line being studied
PARLN: 0 ;Line count when found
PARDEF: 0 ;Deficiency
PARPRS: 0 ;Pairs of bracketing symbols
PARTOT: 0 ;Total character count
PARCUR: 0 ;Value of CURPAG when command was given
PARARR: 0 ;Value of ARRL when command was given
PAROFF: 0 ;Value of EDCNM when command was given
PARX: 0 ;Flag for Xtend command
PURE
comment ⊗
Register assignment
Register Contents
A Initial argument, then pointer
B Character count
C Character
D Current level
E Temporary ARRLIN for line being searched
G Times at minimum depth
H Flags for special characters
I Least level
DSP Dispatch table address
Q Line count
T Left symbol count
TT Times at greatest depth
end of comment ⊗
;To save current position
PARSAV: MOVE E,CURPAG ;Save data needed by ↔ command to return
MOVEM E,PARCUR
MOVE E,ARRL
MOVEM E,PARARR
MOVE E,EDCNM
TLO E,1
TRNN F,EDITM
SETZ E,
MOVEM E,PAROFF
POPJ P,
;Right parenthesis search
RPAREN: SETOM PARX ;Set extend flag
SKIPA
PARR: SETZM PARX
MOVE C,LEFTC ;Is this a special case with
CAMN C,RITEC ;the left-symbol the same as the right-symbol?
JRST PARL2 ;All searches are for left symbols in this case
MOVEM A,PARMIN ;Testing for a desired minimum
MOVEI Q,77777 ;To prevent exit on left-symbols
MOVEM Q,PARMAX
SOS PARMIN ;Test is made after the symbol instead of before
JRST PAR
;Left parenthesis search
LPAREN: SETOM PARX ;Set extend flag
SKIPA
PARL: SETZM PARX
PARL2: MOVEM A,PARMAX ;Testing for a desired maximum
MOVNI Q,77777
MOVEM Q,PARMIN ;To prevent exit on right-symbols
PAR: MOVEM A,SARG ;Save argument for reporting
PUSHJ P,PARSAV ;To save present conditions
MOVE E,CURPAG
MOVEM E,SRCPG ;Will be updated as multi-page search progresses
SETZM TYOPNT
SETZM ESCIEN ;User has not typed ESC I yet
SETZM ESCI2
HRRZ E,ARRLIN ;Get line location in free storage
MOVEI A,LLDESC(E)
TLO A,440700
MOVEI DSP,PARDSP ;Dispatch table address for displayed page
MOVSI H,NSPEC!LSPC ;Set flags for special characters
SETZB B,PARTOT ;Characters on line, total characters
SETZB TT,PARGDP ;Number of times at greatest level, this level
SETZB G,PARLDP ;Minimum level count,lowest level
SETZB T,D ;Left-symbol count, current level
SETZB Q,I
TRNN F,EDITM ;In line edit mode?
JRST PAR1 ;No
MOVE B,EDCNM ;So positioning will be right in first line
MOVNM B,PARTOT ;but will not count in characters searched
MOVEI DSP,PA1DSP ;Special dispatch table if in line-editor
HRR A,[BUF] ;with data in BUF
JUMPE B,PAR0 ;Start at first character
MOVE G,B
IBP A ;We want A to point to starting position
SOJG G,.-1
PAR0: ILDB C,A ;Look at new first character
CAME C,RITEC ;Are we under a right-symbol?
JRST PAR1B ;We are not, so consider this character
AOJA B,PAR1 ;We are, so count and read another character
;Dispatch table for Buf search (line-editor line)
PA1DSP: AOJA Q,PAR1CR ;Null we should never get here
AOJA B,PAR1 ;BS
AOJA Q,PAR1CR ;CR end of line-editor line
AOJA Q,PAR1CR ;LF treat as missing CR
AOJA B,PAR1 ;TAB TABs are tabs only in BUF
JFCL ;FF should not be in text
JFCL ;ALT should not be in text
;Dispatch table for first page PAREN search (but not line-editor line)
PARDSP: AOJA Q,PARCR ;null we should never get here
AOJA B,PAR1 ;BS we should never get here
AOJA Q,PARCR ;CR increment line count
AOJA Q,PARCR ;LF treat as missing CR
JRST PAR1A ;TAB special treatment on displayed page
JFCL ;FF should not be in text
AOJA B,PAR1 ;ALT should not be in text
;Dispatch table for extend PAREN search
PAXDSP: JRST PARNUL ;null
JRST PARRCD ;177 Normal end of buffer signal
AOJA Q,PARXCR ;CR
AOJA Q,PARXCR ;LF treat as missing CR
AOJA B,PAR1 ;TAB as any other char
JRST PARFF ;FF
AOJA B,PAR1 ;ALT
;Dispatch table for Xtent CR
PACDSP: JRST PARXC2 ;Null pass it on after resetting DSP
JRST PARRCD ;177 End of buffer just after a CR
AOJA Q,PARXC1 ;CR count it and still look for a LF
JRST [MOVEI DSP,PAXDSP
JRST PAR1] ;LF eat it and reset DSP
JRST PARXC2 ;TAB pass it on
JRST PARXC2 ;FF pass it on
JRST PARXC2 ;ALT pass it on
;To report ESC I interuption
PARESC: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /ESC I termination at end of page /]
SETZM TYOPNT
TYPDEC SRCPG
OUTSTR [ASCIZ / while looking for /]
MOVE Q,PARMAX
CAIL Q,77777 ;What were we looking for?
JRST PARES2 ;A right-symbol
MOVE C,LEFTC ;Report the left-symbol
TYPCHR (C) ;before the argument
TYPDEC SARG
JRST PARTY5
PARES2: MOVE C,RITEC ;Report the right-symbol
TYPDEC SARG ;after the argument
TYPCHR (C)
JRST PARTY5
;Test for ESC I interruption
PARFF: SKIPE ESCIEN
JRST PARESC ;Interruption
;Code to update page count and display it after the second page
;on finding a FF in the text at any point
PARFF2: ADDM B,PARTOT ;Accumulate char count
SETZB B,Q ;and reset B and Q
PUSHJ P,SRCFPP ;Add to page count and display number
JRST PAR1
PARXCR: MOVEI DSP,PACDSP ;Special dispatch in this case
ADDM B,PARTOT ;Add to total character count
SETZ B, ;and start over
SKIPE EDFIL-2 ;Is this a /F/R file?
CAMGE Q,EDFIL-2 ;And is a pseudo FF indicated?
JRST PARXC1 ;No
SKIPE ESCIEN
JRST PARESC ;An ESC I interuption
PUSH P,A ;Save pointer
ILDB C,A
CAIN C,14 ;Is next char a FF?
JRST PARXCB ;Yes, so let nature take its course
CAIE C,12 ;Maybe it is a LF
JRST PARXCA ;No, so a pseudo FF is indicated
ILDB C,A ;In this case test the next char
CAIN C,14 ;It may be a FF
JRST PARXCB ;It is, so all is well
PARXCA: SETZ Q, ;Ii is not, so reset line count
PUSHJ P,SRCFPP ;Add to page count and display it
PARXCB: POP P,A ;Restore A
PARXC1: ILDB C,A ;We must look at the next character
TDNE C,CTAB(C)
XCT @CTAB(C)
PARXC2: MOVEI DSP,PAXDSP ;Reset dispatch index
JRST PAR1B ;Already have next character
PAR1X: CAME DSP,[PACDSP] ;See where we came from
JRST PAR1 ;Normal return from new buffer load
JRST PARXC1 ;Must still look for a LF
PAR1CR: MOVEI DSP,PARDSP ;Not found on line-edit line
PARCR: ADDM B,PARTOT ;Add to total character count
SETZ B, ;Start count over
HRRZ E,(E) ;go to the next line of text
CAIN E,BOTSTR ;Are we at the end of the page?
JRST PAREX ;Yes
MOVEI A,LLDESC(E)
TLO A,440700
;Start of inner loop. Used for both displayed-page search and extended search
;DSP set to PARDSP, PAXDSP or PACDSP depending on circumstances
PAR1: ILDB C,A
PAR1B: TDNE H,CTAB(C)
XCT @CTAB(C)
CAMN C,LEFTC ;Are we at a LEFT-SYMBOL?
AOJA D,PAR2 ;Yes
CAMN C,RITEC ;Are we at a RIGHT-SYMBOL?
SOJA D,PAR2A ;Yes
AOJA B,PAR1 ;Go around again
;End of inner loop
;We've found a TAB (on the displayed page)
PAR1A: ILDB C,A
CAIE C,11
JRST .-2 ;Eat to next TAB
AOJA B,PAR1
;We've found a left-symbol
PAR2: AOJ T, ;Count as start of another pair
AOJ I, ;The old minimum no longer holds
CAMGE D,PARGDP ;Are we at less than the maximum level?
AOJA B,PAR1 ;Yes, so go to next character
CAMG D,PARGDP ;Have we been to this level before?
AOJA TT,PAR3 ;Yes, so add to count of number of times here
MOVEI TT,1 ;Start the count for number of times at this level
AOS PARGDP ;And add to the maximum level
CAML D,PARMAX ;Are we at the desired level?
JRST PARFND ;Yes
PAR3: AOJA B,PAR1 ;Go to next character
;We've found a right-symbol
PAR2A: CAMLE D,PARGDP ;Are we at greater than the minimum level?
JRST PAR2B ;Yes
CAML D,PARGDP ;Have we been at this level before?
AOJA G,PAR2B ;Yes, so add to count
MOVEI G,1 ;Start the count for this new level
SOS PARGDP ;and subtract from the minimum level
PAR2B: CAMGE D,PARMIN
AOJA B,PAR1
CAMGE D,I
MOVEM D,I
CAME D,PARMIN
AOJA B,PAR1
;We've found the desired right-symbol
PARFND: SETZM PARDEF
MOVNS PARLDP ;Negative of minimum level encountered
MOVEM G,PARTML ;Times at this level
PARNOT: MOVEM T,PARPRS ;Number of left-symbols found
MOVEM TT,PARTMS ;Times at this level
MOVEM B,PARCT
ADDM B,PARTOT
MOVEM Q,PARLN ;Free register
PARTYP: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Sought Found Chars./]
SKIPE PARDEF
OUTSTR [ASCIZ / Deficiency /]
SKIPE PARX ;Was it an extend command?
OUTSTR [ASCIZ /Thru page/]
OUTSTR [ASCIZ /
/]
MOVE Q,PARMAX
CAIL Q,77777 ;What were we looking for?
JRST PARTY1 ;A right-symbol
MOVE C,LEFTC ;Report the left-symbol
TYPCHR (C) ;before the argument
TYPDEC SARG
JRST PARTY3
PARTY1: MOVE C,RITEC ;Report the right-symbol
TYPDEC SARG ;after the argument
TYPCHR (C)
PARTY3: SKIPE PARDEF
OUTSTR [ASCIZ/ No /]
SKIPN PARDEF
OUTSTR [ASCIZ / Yes /]
TYPDEC PARTOT
OUTSTR [ASCIZ / /]
SKIPN PARDEF ;Were we successful?
JRST PARTY2 ;Yes
SKIPL PARDEF
JRST .+3
TYPCHR "↓"
MOVNS PARDEF
TYPDEC PARDEF
OUTSTR [ASCIZ / /]
PARTY4: SKIPN PARX
JRST PARTY6 ;Not an extend case
TYPDEC SRCPG
PARTY5: PUSHJ P,DSHED ;Force redisplay of header line
XCT SRCDP3 ;Clear search page number if on III
PARTY6: TRNN F,EDITM
JRST PPJ1CR ;Not from line editor--put out CRLF and skip return
JRST REEDT2 ;Don't say HUH
;We have been successful
PARTY2: OUTSTR [ASCIZ / /]
TRNN F,EDITM ;Did we come from line editor?
JRST PARTY8 ;No
SKIPE PARLN ;Yes, but are we in the same line?
JRST PARTY7 ;No
MOVE A,SRCPG ;Yes, but is it the
CAMN A,CURPAG ;same page?
JRST PARTY9 ;Yes, so simply move cursor
PARTY7: PUSHJ P,FNEDIT ;We must save the edited version of the line
PARTY8: MOVE A,SRCPG ;Desired page
CAME A,CURPAG ;Are we on it?
PUSHJ P,NEWPG0 ;No, so get there
MOVE A,PARLN ;MOVARR wants line count in A
PUSHJ P,MOVARR ;Get to correct line
SKIPN IMLDPY
JRST PPJ1CR ;No line editor--put out CRLF and take skip return
PUSH P,PARCT
PUSH P,[240]
JRST EDIT1
PARTY9: PUSH P,PARCT
JRST EDTMR2 ;Edit same line at required place
PARER1: SORRY Directory not complete.
JRST PAREXX
PARERR: SORRY Disk IO error!
JRST PAREXX
PAREX: SKIPGE PARX ;Is this an EXTENT case
JRST PAREXT ;Yes, we must now search the other pages
PAREXX: MOVNS PARLDP ;Negative of minimum level encountered
MOVEM G,PARTML ;Times at this level
MOVE Q,PARMAX
CAIL Q,77777
JRST PAREX2 ;We were looking for a right-symbol
MOVE G,PARMAX
SUB G,PARGDP
MOVEM G,PARDEF
JRST PARNOT
PAREX2: MOVE G,PARGDP
CAMG G,PARMIN ;Did we ever reach the desired level
JRST PAREX3 ;No
SUB I,PARMIN ;Yes, but how far did we miss getting back?
MOVEM I,PARDEF
JRST PARNOT
PAREX3: MOVE G,PARGDP
SUB G,PARMIN
SOJ G,
MOVEM G,PARDEF
JRST PARNOT
;This code puts you back from whence you came on the last (, ) or ↔ command
PARB: SKIPGE PARCUR ;Any place saved to go back to?
JRST PARB2 ;Nope
PUSH P,PAROFF
PUSH P,PARARR
PUSH P,PARCUR
PUSHJ P,PARSAV ;So we can get back here
TRNE F,EDITM ;Did we come from line editor?
PUSHJ P,FNEDIT ;Yes, save the edited version of the line
POP P,A
CAME A,CURPAG
PUSHJ P,NEWPG0
SETZM TYOPNT
OUTSTR [ASCIZ / Going back. /]
POP P,A
PUSHJ P,SETARR
POP P,A ;Test offset
JUMPE A,POPJ1 ;Don't go to line editor if not called from there
SKIPN IMLDPY
JRST POPJ1 ;No line editor to go to
ANDI A,-1 ;We have a bit in left half, which EDIT doesn't want
PUSH P,A ;Put offset back on the stack
PUSH P,[240]
JRST EDIT1
PARB2: SORRY No place to go back to.
TRNN F,EDITM ;Are we from the line editor?
JRST POPJ1 ;No
JRST REEDT2 ;Yes, don't say HUH
;To get next block on finishing the displayed page
PAREXT: SKIPE ESCIEN
JRST PARESC
MOVE A,DIRPT
HRRZ C,(A)
CAMN C,DIREND
JRST PAREXX ;There are no more pages
SKIPN A,1(C)
JRST PARER1
MOVEI DSP,PAXDSP ;Set DSP for EXTEND search
SETZB B,Q ;B has probably been reset but just in case
HRRZ C,A
PUSHJ P,SRCFPP ;Updata page number and display
ANDCMI A,-1
ROT A,7
ADD A,IBFPNT
IBP A
CAMN C,IBLK ;Don't USETI if already there
JRST PAR1
PUSH P,A
MOVE A,C
XCT %SETI
POP P,A
MOVEM C,IBLK
JRST PARRC2
;Reload when buffer is exhausted
PARRCD: SKIPLE PARX
JRST PAREXX ;Not found
MOVE A,[440700,,IBUF]
AOS IBLK
PARRC2: XCT %IN
JRST PAR1X ;Continue, but test if previous char was a CR
XCT %STAT
TRNN C,20000 ;EOF?
JRST PARERR ;No, something wrong
MOVE C,IBLK
SUBI C,1 ;Anticipated too soon
LSH C,7 ;Number of words successfully read
SUB C,FILWC ;Negative of number of real words in last buffer
JUMPGE C,PAREXX ;No more data
MOVN C,C ;Incomplete record case
SETZM IBUF(C) ;Fill rest of buffer with nulls
MOVEI C,IBUF+1(C)
HRLI C,-1(C) ;pointer to BLT rest of buffer with nulls
CAME C,[IBUF+177,,IBUF+200] ;Don't do BLT if only one word left
BLT C,IBUF+177
MOVEI C,777
MOVEM C,PARX ;Flag for no more text
JRST PAR1X ;Continue after test
;Fast handling of words full of nulls
PARNUL: CAMGE A,[100700,,0] ;Is the null at the end of a word?
SKIPE 1(A) ;Is next word all nulls?
JRST PAR1 ;No
AOJA A,.-2 ;Yes, so try with the next word
;BACKGO BEEPCK BEEPST BEEPS1 BEEPME BEEPUU
BACKGO: SKIPL A,LSTPLC
JRST BACKG2
SORRY No place to go back to.
JRST POPJ1C
BACKG2: PUSH P,LSTWIN
PUSH P,A ;Save line number, which NEWPG0 will clobber.
HLRZ A,A ;Page number.
PUSHJ P,NEWPG0
JFCL ;NEWPG0 should never skip, but no real harm if it does
POP P,A ;Line number.
HRRZ A,A ;Clear page number from left half.
PUSHJ P,SETARR ;Get to line we came from
POP P,A
JRST SETWIN ;Restore same window as before
;Test of a simple BEEPing routine that beeps on completion of those commands
;taking longer than X seconds of real time to execute, where X is settable.
IMPURE
BEEPNO: -1 ;Flag which if non-zero disables beeping.
BEEPLN: 74*=10 ;Duration above which we beep.
BEEPTM: 0 ;Real time we started executing command.
BEEPUU: 0 ;UUO used to "beep" him
OUTCHR ["π"] ;TTY. Type a ↑G--bell.
ADSMAP T, ;DD. Clever how we never use BEEP to beep him.
ADSMAP T, ;III
PURE
BEEPCK: SKIPE BEEPNO
POPJ P,
TIMER T, ;See if we should beep now.
SUB T,BEEPTM
CAMG T,BEEPLN
POPJ P, ;No.
BEEPM3: MOVE T,[630005,,2] ;Temporary beep for 1/2 sec.
XCT BEEPUU ;ADSMAP if display, type ↑G if TTY.
POPJ P,
BEEPST: SKIPN BEEPNO ;Don't do UUO if not enabled.
TIMER T,
MOVEM T,BEEPTM
POPJ P,
;Routines that read arguments from the TTY should call this after finished reading.
BEEPS1: PUSH P,T ;Safe way to store current time
PUSHJ P,BEEPST
JRST POPTJ
BEEPM2: TRNN F,REL
JRST BEEPM3 ;Beep now.
JRST BEEPM4 ;Enable beeps.
BEEPM1: SETOM BEEPNO ;Disable beeps.
OUTSTR [ASCIZ/Beeping disabled./]
JRST PPJ1CR
BEEPME: JUMPLE A,BEEPM1
TRNN F,ARG
JRST BEEPM2
IMULI A,74 ;Convert to ticks.
MOVEM A,BEEPLN
BEEPM4: SETZM BEEPNO
OUTSTR [ASCIZ /Beep set for /]
MOVE A,BEEPLN
IDIVI A,74
SETZM TYOPNT ;Force output to TTY.
TYPDEC A
OUTSTR [ASCIZ / seconds (real time)./]
PUSHJ P,BEEPST
JRST PPJ1CR
;MSG CHKMSG MSG0B MSG0A MSG0 MSG1 MSG2 MSG5 MSG6 MSG7 MSGLUZ MSGBK MSGBK0 CHKMS0
;This is the partial-sign command, designed for handling
;MAIL messages (which are delimited by partial-signs).
MSG: MOVEM A,SARG ;Save number of messages to find.
MOVEI DSP,CMDSP
JUMPE A,MSG0B ;If he said 0∂, then just move to top of current msg
PUSHJ P,CMDIN ;Read command from console.
JRST POPJ2 ;Illegal command. Type out message.
MOVEM D,SDSP
EXCH A,SARG
HRLI C,(B)
MOVEM C,SCHR
MSG0B: PUSH P,A ;Save arg to ∂ command
MOVE B,ARRL ;Look backwards from current line for ∂ line
MOVE D,ARRLIN
JUMPG A,.+2
SUBI A,1 ;-#∂ means # msgs BEFORE current one.
MSG0: LDB C,[POINT 7,LLDESC(D),6] ;Get first char of line
CAIE C,"∂"
JRST MSG0A
TLNN B,-1 ;Got beginning
HRLI B,(B) ;Remember line number of first beginning seen.
AOJGE A,MSG1 ;Jump if found enough beginnings
MSG0A: HLRZ D,(D) ;Back up to previous line
SKIPL TXTFLG(D) ;Backing up to pagemark?
CAIN D,PAGE ; or to beginning of page?
JRST MSG1 ;Yup
SOJA B,MSG0 ;No
MSG1: PUSH P,B ;Save <start of current msg>,,<start of range>
SKIPG A,-1(P) ;Was original arg non-positive?
JRST MSGBK ;Yes
MOVE B,ARRL ;Now look forward from line beyond current for ∂
MOVE D,ARRLIN
MSG2: SKIPL TXTFLG(D) ;Is this a pagemark?
CAIN D,BOTSTR ;Or end of page?
SOJA B,MSG5 ;Yes--did not find ending ∂. B is end of range
HRRZ D,(D) ;Next line
LDB C,[POINT 7,LLDESC(D),6] ;Get first char of line
CAIN C,"∂"
SOJLE A,MSG5 ;Got beginning of new msg. Jump if found enough.
AOJA B,MSG2 ;Next line
MSGLUZ: PUSHJ P,ABCRLF
SORRY Not Found - Header (∂) for Previous Message.
JRST POPJ1
MSGBK: JUMPE A,MSGBK0
HLRZ B,B
SOJA B,MSG5 ;Mark end of range as before current msg
MSGBK0: HLRZ A,B ;Get start of current msg
SUB P,[2,,2] ;Re-adjust stack
JRST SETARR ;Go there, ignoring command.
WHOLEP←←765432 ;special value used as a flag to delete page mark.
MSG5: POP P,A ;<start of current msg>,,<start of range>
SUB P,[1,,1] ;Original arg
HLRZ D,A ;Start of current msg
MOVEI A,(A) ;Start of range
CAIE A,1 ;Is range the whole page?
JRST MSG6 ;No
CAMN B,LINES ;Does range end at end of page?
MOVEI B,WHOLEP ;Yes, flag that to DELLIN and ATTACH
MSG6: EXCH D,SDSP ;Restore orginal dispatch, save start of current msg
ADDI B,1 ;Make sure we get whole message, including last line
MOVEM B,SRCL ;Save number of ending line in range
CAIG B,(A) ;End of range+1 > Start of range?
JRST MSGLUZ ;No, loser loses
SETOM SRCOFF ;Found ∂ at beginning of line.
SETZM QCHR ;Just in case, avoid any substitution.
CAML A,SDSP ;Are we searching backwards?
JRST MSG7 ;No
CAME D,CRDSP ;Is this a regular CR?
TLNN D,SACMD ;No, this command use search distance as arg?
MOVEM A,SRCL ;No, make sure we get to beginning of earliest msg
SKIPE B,ATTNUM ;Anything attached?
TLNN D,MSGCMD ;Yes, do we put down attach buffer for this cmd?
JRST MSG7 ;No
ADDM B,SRCL ;Make sure we include the text we are putting down
EXCH A,SDSP ;Get beginning of current msg, save beginning of range
PUSHJ P,SETARR ;Move to beginning of current msg
PUSHJ P,ATTEX ;Put down attach buffer
TRZ F,ATTMOD ;No longer in attach mode
MOVE A,SDSP ;Retrieve beginning of range
MSG7: PUSHJ P,SETARR ;Move to beginning of range
TLZ D,SSCMD ;No special commands here
JRST FND2A ;Now go process command
CHKMS0: SUB P,[1,,1] ;Here from DELLIN with no lines deleted--fix stack
;Come here from end of DELLIN and ATTACH to see if need to delete page mark
CHKMSG: MOVE A,SAVARG
TRNN F,REDNLY!EDDIR ;No page deleting in /R mode or on directory page
CAIE A,WHOLEP ;Did we just now delete or attach whole page's text?
POPJ P, ;No
MOVE T,CURPAG ;Yes, delete next page mark if there is one
CAMGE T,PAGES
JRST DELETE
;No next page, delete previous page mark if can
MOVE A,FIRPAG
SUB A,DIRPAG
SOJLE A,CHKMS2 ;Jump if this is the only page except the directory
PUSHJ P,WINCHK ;Fix up the window pointers so -FF will work
PUSHJ P,VERTB2 ;Do a -FF to get to end of previous page
SKIPN A,ATTLOC
JRST DELETE ;Now delete page mark (deleting last page of file)
SUBI A,1 ;Since we just attached a page's text and
HRL A,ARRL ; we are deleting that page, pretend text picked up
MOVEM A,ATTLOC ; from end of previous page.
JRST DELETE ;Now go actually delete the last (empty) page of file
CHKMS2: CAMN T,FIRPAG ;Better be only one page in core
SETOM DELFIL# ;Note that all text has been deleted with ∂ command
POPJ P,
;MACDEF MACCAL MACSTP MACESC MACLIN MACTYP MACINT MACLTT MACKLD
IMPURE
TTYPNT: 0
0 ;Byte ptr gets stuffed here for PTWRS9 on TTY.
MACLEN←←=60 ;This gives us up to =239 chars in macro.
MACBUF: BLOCK MACLEN
PURE
MACLIN: MOVEM D,TTYPNT+1 ;On TTY, we do PTWRITE of line.
PUSH P,B
MOVEM C,MACKLU ;No α<tab> seen yet, unless it was initial char
ANDI C,737 ;Make it upper case but preserve control bits
CAIE C,200!"K" ;One last kludge to fix another special case bug
CAIN C,200!"S"
JRST MACL8A ;αK or αS as first char has following arg
MACLN0: PUSHJ P,TYI ;Get char from def
JRST MACLN2 ;Might be activator
MACLN1: IDPB C,D ;Not activator, stuff it
TRNE C,600 ;If no control bits, don't touch α<tab> flag
MACLN9: MOVEM C,MACKLU# ;Save char for α<tab>αD kludge
JRST MACLN0
MACKLD: MOVE B,MACKLU ;Get last character output
CAIE B,211 ;We consider αD an activator if preceded by α<tab>
JRST MACLN1 ;Just line editor command (hope, hope!)
JRST MACLN3 ;Activator, that's enough for line editor (for sure)
MACLN8: IDPB C,D ;Store αK or αS
MACL8A: PUSHJ P,TYI ;Get char arg of line editor cmd
JFCL ; Always is arg, never activator here
IDPB C,D ;Put in the arg
SKIPE MACPNT ;Just in case αK or αS was last char in macro
JRST MACL10 ;Get more line editor stuff
MOVEI C,175 ;Macro ended--get an altmode to throw away
JRST MACLN3 ;All done
MACL10: XORI C,15≠11 ;αS or αK followed by CR simulates α<tab>
TRO C,200 ;Make it α<something>
ANDI C,377 ;But make sure β is off
JRST MACLN9 ;This also ensures αKα<tab> doesn't set α<tab> flag
MACLN7: CAIE C,415 ;Meta CR?
CAIN C,412 ;Meta LF?
JRST MACLN3 ;Activator
CAIE C,575 ;Meta Altmode?
JRST MACLN1 ;Meta <non-activator> is a line editor command
JRST MACLN3 ;Activator
MACLN2: CAIN C,177 ;BS is a line editor command.
JRST MACLN1
LDB B,[POINT 2,C,28] ;Get control bits.
CAIN B,2
JRST MACLN7 ;Meta almost anything is line editor command.
CAIE B,1
JRST MACLN3 ;Not a line editor command, must be activator.
LDB B,[POINT 7,C,35] ;Char without bits
CAIN B,14 ;α<FF>?
JRST MACLN1 ;A line editor command.
CAIL B,"0"
CAILE B,"9"
CAIN B,177 ;α<BS>?
JRST MACLN1 ;Control digits and α<BS> are line editor commands
CAIE B,"K"
CAIN B,"k"
JRST MACLN8 ;Line editor command with following arg
CAIE B,"S"
CAIN B,"s"
JRST MACLN8 ;Line editor command with following arg
CAIE B,"D"
CAIN B,"d" ;Jesus, there are a lot of special cases here!
JRST MACKLD ;αD is sometimes an activator--kludge!!!
MOVE B,CTAB(B)
TLNE B,100
JRST MACLN1 ;A line editor command, stuff in buffer and go on.
MACLN3: SKIPN DPY
JRST MACLTT
MACLN5: SKIPN MACPNT ;Still expanding macro?
CAIE C,175 ;No, is this the extra altmode inserted?
MACLN6: IDPB C,D ;No, put it into buffer for PTL7W9
POP P,B
SKIPE DPY
POPJ P,
MOVEI C,0
IDPB C,D
PUSHJ P,DISP
JFCL ;Always update display (unless still inside macro).
PUSHJ P,ABCRL0 ;Put out CRLF if necessary.
PTWRS9 TTYPNT
MOVE D,TTYPNT+1
POPJ P,
MACLT2: CAIE B,175 ;Is this really an activator on TTY?
CAIN B,12
JRST MACLN5 ;Yes
JRST MACLN1 ;Not an activator on TTY, keep reading
MACLTT: LDB B,[POINT 7,C,35]
CAIE B,15
JRST MACLT2
IDPB B,D ;Put CR into string for PTWRS9
XORI C,15≠12 ; followed by LF with whatever bits there may be
JRST MACLN6
;Here when defining a macro.
MACDEF: SKIPE MACPNT
JRST MACDE1 ;Macro is redefining itself, don't prompt user.
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Type Macro's character string followed by /]
SETO T,
GETLIN T
TLNE T,IMLIN
JRST MACDE0 ;IMLACs are funny (so what if detached?).
SKIPN DPY
OUTSTR [ASCIZ/<control>Z
/]
SKIPE DPY
MACDE0: OUTSTR [ASCIZ/<CONTROL><META><LINEFEED>
/]
MACDE1: MOVEI E,MACLEN*4-1 ;Maximum number of characters in macro def.
MOVE D,[POINT 9,MACBUF]
JRST MACDE3
MACLNG: OUTSTR [ASCIZ/
Macro definition is too long (more than 119 chars)--not saved. /]
SETZM MACBUF ;Flush macro def.
JRST POPJ1
MACDE2: SOJLE E,MACDE3
IDPB C,D
MACDE3: PUSHJ P,TYI
JFCL
JUMPE C,MACDE4
CAIE C,612 ;↑Z OR αβ<LF>?
JRST MACDE2
MACDE4: PUSHJ P,MACSTP ;Can't continue macro expansion after redefining.
JUMPLE E,MACLNG
CAIN E,MACLEN*4-1 ;Anything typed?
JRST MACABT ;No, don't change any old def.
MOVEI C,0
IDPB C,D ;Mark end of macro def.
OUTSTR [ASCIZ/
The Y command expands the macro./]
JRST MACTYP
MACEND: SOSLE MACARG
JRST MACEN2 ;Continue by calling macro again.
MACEN1: SETZM MACXIP
SETZM MACPNT ;ESC I could have come along and put something here.
OUTSTR [ASCIZ/ Macro ended. /]
MACEN3: MOVEI C,175 ;Insert an altmode at end of macro expansion.
JRST POPUP ;Return from TYICHK: up level means got character.
MACEN2: SKIPN MACBUF ;Make sure there is still a macro there.
JRST MACEN1
MOVE C,[POINT 9,MACBUF] ;Re-initialize pointer to macro string
MOVEM C,MACPNT
JRST TYI5 ;Continue by getting a character.
;Get here when ESC I has interrupted macro expansion.
MACINT: PUSHJ P,ABCRL0 ;Output CRLF if needed.
OUTSTR [ASCIZ / ESC I -- Unexecuted part of macro: /]
PUSH P,D ;Preserve D
PUSH P,B ;PRNTCH clobbers B
MOVE D,MACSAV# ;Pick up byte pointer that was saved by ESC I
PUSHJ P,MACTP3
POP P,B
POP P,D
JRST MACEN3
MACUND: OUTSTR [ASCIZ/ No macro defined. /]
JRST POPJ1
MACTYP: MOVE D,[POINT 9,MACBUF]
AOS (P)
OUTSTR [ASCIZ/
Macro defined as: /]
JRST MACTP3
MACTP2: TRZE C,200
OUTCHR ["α"]
TRZE C,400
OUTCHR ["β"]
PUSHJ P,PRNTCH
MACTP3: ILDB C,D
JUMPN C,MACTP2
OUTCHR [" "]
POPJ P,
;Here when calling a macro
MACCAL: SKIPN MACBUF ;Any macro defined?
JRST MACUND ;No
JUMPE A,MACTYP ;Arg of 0 means type out macro.
MOVMM A,MACARG# ;Number of times to call macro.
SETOM MACXIP# ;Set macro-in-progress flag, which is used by ESC I.
MOVE T,[JRST MACEND]
MOVEM T,MACINS ;Stuff to do at end of expansion.
MOVE T,[POINT 9,MACBUF] ;Note that if a macro calls itself, the first call
MOVEM T,MACPNT ; is flushed by the second call, which continues.
JRST POPJ1 ;Don't say OK, especially if from line editor.
;Error routines that want to stop macro expansion should PUSHJ P,MACSTP.
MACSTP: SETZM MACXIP
SKIPN MACPNT ;Any macro expansion in progress?
POPJ P, ;No
SETZM MACPNT
OUTSTR [ASCIZ/ Macro expansion aborted. /]
POPJ P,
COMMENT ⊗ DOCUMENTATION:
There is only one macro definition allowed. Definition is made by
using the XDEFINE<cr> command which should be followed by the
character string representing the macro definition and then
<ctrl><meta><lf> (or ↑Z for TTYs). The macro is called by αY or αβY.
Macro expansion can be terminated by ESC I which will stop it at the
next input character, for which an altmode will be used. If the
macro calls itself, it should do so only as the last thing in the
macro, because the first call will be terminated and replaced by the
second call which will start from the beginning of the definition.
When E needs an answer to a Yes or No question in the middle of
processing some command, it will get the answer from the TTY, never
from a macro definition; and unless the answer is Yes, expansion of
the macro (if currently in progress) will be terminated.
A macro can be forced to execute a number of times by calling it with
a numeric argument. A zero argument will simply cause the macro
definition to be typed out.
The display will not be updated until the macro expansion has terminated,
except that the V (or XDRAW) command encountered during macro expansion
will force immediate updating of the display. Note that αβV erases the
screen and then redisplays, whereas αV just redisplays the screen (this
is true outside of macro expansion as well as inside).
No prompts (eg, COMMAND) if expanding macro and no "OK" if expanding.
Macro expansion will be terminated by any of the following:
1)Unsuccessful search and/or substitute.
2)Command error.
3)ESC I.
4)End of macro definition and running out of numeric argument to macro call.
5)Calling of itself. Second call will go on, first is terminated.
6)Answer to Yes or No question other than Yes.
7)XDEFINE command executed from macro expansion. Redefinition will be valid.
Possible FUTURE features:
Retrieving the control bits and/or numerical argument of the macro
call for use with some command(s) in the macro expansion. E.g.,
XARGUMENT<CR> in a macro expansion will cause the argument typed to
the call to be passed to the next command in the expansion.
Similarly, XBITS<CR> in a macro expansion will cause the bits typed
to the call to be passed to (or perhaps ORed into) the next command
in the expansion. These commands (XARG and XBITS) would be no-ops
outside macro expansion.
Should macro characters be typed out during expansion? Option later, now NO.
end of comment ⊗
;BURP BURPEX UPDATE PROTEC AUTOBU
BRPTHR←←23 ;Default threshhold for automatic burping
IMPURE
BURPEX: -BRPTHR ;negative of auto burp threshold in records of nulls
;Zero or a positive number disables auto burping
PURE
BURP: TRO F,WRITE!XPAGE ;Force it to RIPPLE to discard records of nulls
JRST WRPAGE
AUTOBU: TRNE F,ARG
JRST AUTOB3 ;Some arg specified, use it
JUMPL A,AUTOB3 ;Just "-" means disable
MOVN A,BURPEX ;Get old value in case just telling threshold
TRNE F,REL
MOVEI A,BRPTHR ;Just + enables with default threshold
AUTOB3: MOVNM A,BURPEX ;Set auto burping threshold
JUMPLE A,AUTOB2
OUTSTR [ASCIZ/Auto Burp threshold is now /]
SETZM TYOPNT
TYPDEC A
OUTSTR [ASCIZ/ records of nulls.
/]
JRST POPJ1
AUTOB2: OUTSTR [ASCIZ/Auto Burping is now disabled. /]
JRST POPJ1
UPDATE: SKIPE XDIRFG ;Has directory been extended in core, not on disk?
PUSHJ P,OUTDIR ;Yes, force out directory now
SETZM XDIRFG ;Everything fixed on disk now
MOVEI T,1
MOVEM T,UFLAG ;Don't display "U" anymore
MOVEM T,UFLAG2
JRST DSHED ;Force redisplay of header line
;Code to report protection and to allow it to be changed.
PROTEC: SETZM TYOPNT
MOVEI G,[ASCIZ/ /] ;G is pointer to string to type when done
OUTSTR [ASCIZ / Protection /]
MOVE T,EXTPNT ;Data already gobbled into EXTBUF by EXTEND
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,TYI
JRST PROTE5 ;Report only
TRNE F,REDNLY
JRST PROTE2 ;Do not change if in readonly
SKIPN EDFIL
JRST PROTE5 ;To prevent deletion if bug exists
MOVEI A,0
MOVEI B,3
PROTE0: CAIG C,71
CAIGE C,60
JRST PROTE1 ;No, can not change after all
LSH A,3
ADDI A,-"0"(C)
PUSHJ P,TYI
JRST PROTE4 ;Last character found
SOJG B,PROTE0
PROTE1: OUTSTR [ASCIZ /(only 3 octal digits allowed) /]
JRST PROTE5
PROTE2: MOVEI G,[ASCIZ /; cannot be changed in READONLY mode. /]
JRST PROTE5
PROTE3: OUTSTR [ASCIZ /cannot be changed/]
MOVE T,PROTEZ ;Get old value
DPB T,[331100,,EDFIL+2] ;and restore it
MOVEI D,EDFIL ;RENAME failure closed the file, so must reopen
MOVEI A,1
PUSHJ P,OPNOI ;Open for input at least
PUSHJ P,TELLZ ;Better not lose
MOVEI E,EDFIL
TLZE F,ENTRD ;If was open in RA mode, open again in RA mode
PUSHJ P,OPENW
JRST PROTE6
PROTE4: LDB T,[331100,,EDFIL+2]
MOVEM T,PROTEZ# ;Save for reporting and to restore if error
REPEAT 0,< ;temporary fix to avoid system BAD RETRIEVAL bug in RENAME
MOVE TT,RPPN
CAMN TT,EDFIL+3 ;If file is user's own, cannot get protection failure
JRST PROTE7 ;Own file
TLNE F,ENTRD ;Also, no bug if file not being written
TRNN T,44 ;Is this file protection protected?
JRST PROTE7
OUTSTR [ASCIZ /cannot be changed/]
JRST PROTE6 ;Avoid bug in system: getting bad retrieval if RENAME fails
PROTE7:
>;end temporary fix
HLLZS EDFIL+1
SETZM EDFIL+2
DPB A,[331100,,EDFIL+2]
RENAME DSKO,EDFIL
JRST PROTE3 ;Something is wrong
OUTSTR [ASCIZ /changed to /]
MOVE T,A
PUSHJ P,OCT3ST
OUTSTR C
PROTE6: OUTSTR [ASCIZ / from /]
SKIPA T,PROTEZ ;Restore data for reporting
PROTE5: LDB T,[331100,,EDFIL+2]
PUSHJ P,OCT3ST
OUTSTR C
OUTSTR (G)
PROTEX: SETZM TYIPNT
JRST PPJ1CR
;MAIL SEND REMIND
IMPURE
0 ;For FILERR
'DSK ' ;For FILERR
MAIFIL: 'E$MAIL'
'TXT '
0
MAIPPN: 0 ;Will put login PPN here
0 ;For FILERR
MAIFLG: 0 ;Flag for spooler output routine: -1 if from MAIL
PURE
MAISWP: 'SYS '
'MAIL '
'DMP',,14
0,,1 ;RPG startup
0
0
MAIL:
SEND:
REMIND: MOVEM A,SPLNBR ;Save number of lines of text to mail
OPEN DSKSP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,RPPN
MOVEM T,MAIPPN
ENTER DSKSP,MAIFIL
JRST MAILUZ
SETOM MAIFLG ;Flag routine not to start spooler
PUSHJ P,MAIOUT ;Use spooler output routine to write file
MOVE 14,MAIFIL
HLLZ 13,MAIFIL+1
SETO 12,
GETLIN 12 ;Pass our TTY number to MAIL
HRLI 12,'RET' ;Tell MAIL to return error msg on failure
MOVE 11,RPPN
MOVEI T,MAISWP
SWAP T,
JUMPN T,POPJ1 ;Success
SORRY File
MOVE T,RPPN
MOVEM T,MAIPPN
MOVEI D,MAIFIL
PUSHJ P,FILTYP
OUTSTR [ASCIZ/ written but no job slot available for MAIL.
/]
JRST POPJ1
MAILUZ: RELEAS DSKSP,
SORRY Cannot deliver message:
MOVEI D,MAIFIL
PUSHJ P,FILERR ;Tell why ENTER lost
JRST PPJ1CR
;ALIAS SETHED ALIAS2 ALIAS3 ALIAS4 ALIAS5
;Routine to set alias (disk ppn).
ALIAS: MOVE T,EXTPNT
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,GETP ;Get project
JUMPN A,ALIAS2
MOVE A,RPPN
JRST ALIAS5
ALIAS4: SORRY Syntax error.
SETZM TYIPNT
JRST POPJ1
ALIAS2: PUSH P,A ;Save project
HRRZ A,RPPN
CAIE C,","
JRST ALIAS3
PUSHJ P,GETP ;Get programmer
JUMPN A,ALIAS3
HRRZ A,PPN
ALIAS3: POP P,B
HRL A,B ;Include project
ALIAS5: CAIE C,15
JRST ALIAS4
TLNE A,-1
TRNN A,-1
JRST ALIAS4
MOVEM A,PPN ;Save new alias
DSKPPN A, ;Set alias
MOVE A,[ASCII/Alias/]
MOVEM A,BUF
MOVE A,[ASCII/ /]
MOVEM A,BUF+1
MOVE A,[POINT 7,BUF+1,6]
MOVEM A,TYOPNT
HLLZ A,PPN
PUSHJ P,PNTYO ;Project to ASCII
TYPCHR ","
HRLZ A,PPN
PUSHJ P,PNTYO ;Programmer to ASCII
TYPCHR "
"
SETZ A,
IDPB A,TYOPNT
SETO A,
GETLIN A
MOVEI T,(A) ;Line number
MOVEI TT,BUF
MOVEI A,T
TTYMES A, ;This way, the alias appears on PP 0, seen after exit
JFCL ;They say this can't happen
PUSHJ P,DSHED ;Force redisplay of header line
AOS (P) ;Don't say OK, but fall into SETHED
SETHED: MOVE A,[ASCID / /]
MOVEM A,HEDNAM
HRRZM A,HEDNAM+1
MOVE A,[HEDNAM+1,,HEDNAM+2]
BLT A,ROFLG-1
MOVE A,[260700,,HEDNAM]
MOVEM A,TYOPNT
MOVEI D,EDFIL
PUSHJ P,FILSTR
MOVEI A,<BYTE(7),,,"/","R"(1)1>
SKIPE RDONLY
TROA F,REDNLY
MOVEI A,1
IFN BOOKMD, {
SKIPE BOOKSW
MOVEI A,<BYTE(7),,,"/","B"(1)1>
};END BOOKMD
MOVEM A,ROFLG
MOVE A,[HEDNAM,,HED2NM]
BLT A,ROFLG2
POPJ P,
;SAVE SPLSTR SAVFIL
IMPURE
0 ;For FILERR (/F)
'DSK ' ;For FILERR
SAVFIL: 'E$SAVE'
'TXT '
0↔0
0 ;For FILERR (/N)
PURE
SAVERR: OUTSTR [ASCIZ/ENTER failed--/]
MOVEI D,SAVFIL
PUSHJ P,FILERR ;Tell how/why he lost
JRST PPJ1CR
SAVE: MOVE T,RPPN
MOVEM T,SAVFIL+3
SETZM SAVFIL+2
HLLZS SAVFIL+1
OPEN DSKSP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
ENTER DSKSP,SAVFIL
JRST SAVERR
SETZM EXAFLG ;Non-formatted output
PUSHJ P,SPLINI ;Initialize output buffer
MOVN B,OCNT
MOVSI B,(B)
SETZM SPLNBR
MOVE D,[POINT 7,TOPSTR+LLDESC]
PUSHJ P,XWRLUP ;Put out top star line
MOVEI A,PAGE
SETO T, ;In case no attach buffer
TRNN F,ATTMOD
JRST SAVE2 ;No attach buffer to output
MOVE T,ARRL
SOJLE T,SAVE3
MOVEM T,SPLNBR
PUSHJ P,XWRLIN ;Put out lines before attach buffer
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
SAVE3: MOVEI TT,=24
MOVEI T,[ASCIZ/ Attach Buffer /]
PUSHJ P,SPLSTR
MOVE T,ATTNUM
MOVEM T,SPLNBR
MOVEI A,ATTBUF
PUSHJ P,XWRLIN ;Put out attach buffer
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
MOVEI TT,=22
MOVEI T,[ASCIZ/ End Attach Buffer /]
PUSHJ P,SPLSTR
MOVEI A,ARRLIN
MOVN T,ARRL
SAVE2: ADD T,LINES
ADDI T,1 ;Include arrow line
MOVEM T,SPLNBR
PUSHJ P,XWRLIN ;Put out lines after attach buffer
MOVE D,[POINT 7,BOTSTR+LLDESC]
SETZM SPLNBR
PUSHJ P,XWRLUP ;Put out bottom stars
PUSHJ P,XWRDON
OUTSTR [ASCIZ/File written: /]
MOVE T,RPPN
MOVEM T,SAVFIL+3
MOVEI D,SAVFIL
PUSHJ P,FILTYP
JRST PPJ1CR
;Routine to put out header or trailer line with surrounding stars
SPLSTR: PUSH P,TT ;Count of number of stars before & after
PUSHJ P,SPLST2 ;Put out some stars
TLOA T,440700 ;Make byte pointer to header text
IDPB C,G
ILDB C,T
JUMPN C,.-2
POP P,TT
PUSHJ P,SPLST2
MOVEI C,15
IDPB C,G
MOVEI C,12
IDPB C,G
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
POPJ P,
SPLST2: JUMPLE TT,CPOPJ ;Return if no stars wanted
MOVEI C,"*"
IDPB C,G
SOJG TT,.-1
POPJ P,
;LBLSRC LBLSR2 LBLERR LBLOOP
LBLERR: MOVEI T,[ASCIZ /Label not found on page indicated by directory -- \/]
JRST FNDER2
LBLSRC: SETZM ESCIEN
MOVE D,T ;Copy search flags
ANDI D,SDELIM ;Only flag of interest later
MOVEM D,LBLFOO ;Save delimiter flag and flag from label search
JRST DIRSR2 ;Use most of old directory searching routine
;Here after getting to page indicated by directory
LBLSR2: EXCH F,SRFLG
SETOM SRCOFF ;No search string found yet.
MOVE T,ARRL
MOVEM T,SRCL
MOVE T,ARRLIN
MOVEM T,SRCLIN ;Start search from arrow line
LBLOOP: MOVEI T,1
MOVEM T,SRCN1 ;Find search string once
PUSHJ P,SRCLBL ;Liks SRCPAG, but searches from SRCLIN
JRST LBLERR
SKIPN LBLFOO# ;Delimited search?
IBP SAVEBP ;No, advance to char after string
LDB T,SAVEBP# ;Get char after string
CAIN T,":"
JRST FOUND ;Eureka!!
CAIE T,"="
CAIN T,"←"
JRST FOUND ;Eureka!!
PUSHJ P,SPFIN ;Set up SRCOFF and SRCNUM for continuing
MOVE F,LBLFOO ;Restore SDELIM flag--only flag needed
SKIPN ESCIEN
JRST LBLOOP
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /ESC I interruption while searching found page for label -- \/]
JRST FNDER5
;PDL,PATCH,PAT,ZVARS,LEGTAB,BUF,TCBUF,RBUF,FNDTBF,FNDBUF,DIR,SYSCMD,TYIPNT
IMPURE
PDL: BLOCK LPDL
EPDL←←.-1 EPDL2←←.-2
TYIPNT: 0
TCPNT: 0
SYSCMD: 0
ZVARS: 0
VAR
DIR: BLOCK LPDESC
DIR2: BLOCK LPDESC ;Saved-directory reference
DIREN2: BLOCK LPDESC ;End of saved-directory reference
FNDTBF: BLOCK SUBBUF+SRSIZ ;To hold both strings for F commands
FNDBUF: BLOCK SUBBUF+SRSIZ ;To hold both strings for X command
SRDUMY: BLOCK SRCBUF
BITBF1: BLOCK 4
BITBF2: BLOCK 4
SBBUF: BLOCK 4
MBBUF: BLOCK 4
VBBITS: BLOCK 6
SBLST: BLOCK 2
BUF: BLOCK 40
BUF2: BLOCK 40
TCBUF←←BUF2
RBUF: BLOCK 40
RSPNT←←RBUF
EVARS←←.-1
PURE
PATCH:
PAT: BLOCK 100
LEGTAB: FOR @! X←0,LEGNUM-1{LEG!X
}LEGCNT←←LEGNUM
XLIST ;THE LITERALS ARE XLISTED FOR YOUR READING PLEASURE
LIT ;DO THESE LAST FOR OPTIMIZATION
LIST
ENDPUR←←.
CHKSUM: 0 ;To hold initial check sum computed in S 137
IMPURE
IFE PURESW,{PURLST←←PURLNK}
ENDLOC←←.
END BEG